packages feed

cabal-debian 4.26 → 4.27

raw patch · 25 files changed

+617/−753 lines, 25 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Debian.Debianize.Prelude: (%=) :: Monad m => Lens a b -> (b -> b) -> StateT a m ()
- Debian.Debianize.Prelude: (+++=) :: (Monad m, Ord b, Monoid c) => Lens a (Map b c) -> (b, c) -> StateT a m ()
- Debian.Debianize.Prelude: (++=) :: (Monad m, Ord b) => Lens a (Map b c) -> (b, c) -> StateT a m ()
- Debian.Debianize.Prelude: (+=) :: (Monad m, Ord b) => Lens a (Set b) -> b -> StateT a m ()
- Debian.Debianize.Prelude: (~=) :: Monad m => Lens a b -> b -> StateT a m ()
- Debian.Debianize.Prelude: (~?=) :: Monad m => Lens a (Maybe b) -> Maybe b -> StateT a m ()
- OldLens: (%=) :: Monad m => Lens a b -> (b -> b) -> StateT a m ()
- OldLens: (~=) :: Monad m => Lens a b -> b -> StateT a m ()
- OldLens: access :: Monad m => Lens a b -> StateT a m b
- OldLens: focus :: (Zoom m n s t, Zoomed n ~ Zoomed m) => LensLike' (Zoomed m c) t s -> m c -> n c
- OldLens: getL :: Lens a b -> a -> b
- OldLens: iso :: (a -> b) -> (b -> a) -> Lens a b
- OldLens: lens :: (a -> b) -> (b -> a -> a) -> Lens a b
- OldLens: modL :: Lens a b -> (b -> b) -> a -> a
- OldLens: setL :: Lens a b -> b -> a -> a
- OldLens: type Lens a b = Lens' a b
+ Debian.Debianize.Prelude: (.?=) :: Monad m => Lens' a (Maybe b) -> Maybe b -> StateT a m ()
- Debian.Debianize.DebInfo: binaryDebDescription :: BinPkgName -> Lens DebInfo BinaryDebDescription
+ Debian.Debianize.DebInfo: binaryDebDescription :: BinPkgName -> Lens' DebInfo BinaryDebDescription
- Debian.Debianize.Prelude: listElemLens :: (a -> Bool) -> Lens [a] (Maybe a)
+ Debian.Debianize.Prelude: listElemLens :: (a -> Bool) -> Lens' [a] (Maybe a)
- Debian.Debianize.Prelude: maybeL :: Lens a (Maybe b) -> Maybe b -> a -> a
+ Debian.Debianize.Prelude: maybeL :: Lens' a (Maybe b) -> Maybe b -> a -> a
- Debian.Debianize.Prelude: maybeLens :: a -> Lens a b -> Lens (Maybe a) b
+ Debian.Debianize.Prelude: maybeLens :: a -> Lens' a b -> Lens' (Maybe a) b

Files

Tests.hs view
@@ -5,13 +5,12 @@     , main     ) where -import OldLens (getL, setL)- import Control.Applicative ((<$>))+import Control.Lens import Data.Algorithm.DiffContext (getContextDiff, prettyContextDiff) import Data.Function (on) import Data.List (sortBy)-import Data.Map as Map (differenceWithKey, intersectionWithKey)+import Data.Map as Map (differenceWithKey, insert, intersectionWithKey) import qualified Data.Map as Map (elems, Map, toList) import Data.Maybe (fromMaybe) import Data.Monoid ((<>), mconcat, mempty)@@ -30,7 +29,7 @@ import Debian.Debianize.Goodies (doBackups, doExecutable, doServer, doWebsite, tightDependencyFixup) 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.Prelude (withCurrentDirectory) import qualified Debian.Debianize.SourceDebDescription as S import Debian.Debianize.VersionSplits (DebBase(DebBase)) import Debian.Pretty (ppShow)@@ -44,15 +43,15 @@ import System.Exit (ExitCode(ExitSuccess)) import System.FilePath ((</>)) import System.Process (readProcessWithExitCode)-import Test.HUnit hiding ((~?=))+import Test.HUnit import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr(..)) import Text.PrettyPrint.HughesPJClass (pPrint, text, Doc)  -- | A suitable defaultAtoms value for the debian repository. defaultAtoms :: Monad m => CabalT m () defaultAtoms =-    do A.epochMap ++= (PackageName "HaXml", 1)-       A.epochMap ++= (PackageName "HTTP", 1)+    do A.epochMap %= Map.insert (PackageName "HaXml") 1+       A.epochMap %= Map.insert (PackageName "HTTP") 1        mapCabal (PackageName "parsec") (DebBase "parsec3")        splitCabal (PackageName "parsec") (DebBase "parsec2") (Version [3] [])        mapCabal (PackageName "QuickCheck") (DebBase "quickcheck2")@@ -64,7 +63,7 @@ testAtoms = newFlags >>= newCabalInfo >>= return . ghc763     where       ghc763 :: CabalInfo -> CabalInfo-      ghc763 atoms = setL (A.debInfo . D.flags . compilerFlavor) GHC atoms+      ghc763 atoms = set (A.debInfo . D.flags . compilerFlavor) GHC atoms  -- | Create a Debianization based on a changelog entry and a license -- value.  Uses the currently installed versions of debhelper and@@ -72,17 +71,17 @@ 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 (A.debInfo . D.changelog) ~= Just log-       (A.debInfo . D.compat) ~= level-       (A.debInfo . D.control . S.source) ~= Just (SrcPkgName (logPackage entry))-       (A.debInfo . D.control . S.maintainer) ~= either error Just (parseMaintainer (logWho entry))-       (A.debInfo . D.control . S.standardsVersion) ~= standards+    do (A.debInfo . D.changelog) .= Just log+       (A.debInfo . D.compat) .= level+       (A.debInfo . D.control . S.source) .= Just (SrcPkgName (logPackage entry))+       (A.debInfo . D.control . S.maintainer) .= either error Just (parseMaintainer (logWho entry))+       (A.debInfo . D.control . S.standardsVersion) .= standards newDebianization _ _ _ = error "Invalid changelog"  newDebianization' :: Monad m => Maybe Int -> Maybe StandardsVersion -> CabalT m () newDebianization' level standards =-    do (A.debInfo . D.compat) ~= level-       (A.debInfo . D.control . S.standardsVersion) ~= standards+    do (A.debInfo . D.compat) .= level+       (A.debInfo . D.control . S.standardsVersion) .= standards  tests :: Test tests = TestLabel "Debianization Tests" (TestList [-- 1 and 2 do not input a cabal package - we're not ready to@@ -104,9 +103,9 @@     TestLabel label $     TestCase (withCurrentDirectory "test-data/alex/input" $               do atoms <- testAtoms-                 actual <- evalCabalT (do (A.debInfo . D.changelog) ~= Just (ChangeLog [testEntry])-                                          (A.debInfo . D.compat) ~= Just 9-                                          (A.debInfo . D.official) ~= True+                 actual <- evalCabalT (do (A.debInfo . D.changelog) .= Just (ChangeLog [testEntry])+                                          (A.debInfo . D.compat) .= Just 9+                                          (A.debInfo . D.official) .= True                                           Map.toList <$> liftCabal debianizationFileMap) atoms                  assertEqual label                    []@@ -127,7 +126,7 @@                               -- inputCabalization top                               finalizeDebianization)                           atoms-                 diff <- diffDebianizations (getL debInfo (testDeb1 atoms)) (getL debInfo deb)+                 diff <- diffDebianizations (view debInfo (testDeb1 atoms)) (view debInfo deb)                  assertEqual label [] diff)     where       testDeb1 :: CabalInfo -> CabalInfo@@ -140,11 +139,11 @@                                                 , ""                                                 , "include /usr/share/cdbs/1/rules/debhelper.mk"                                                 , "include /usr/share/cdbs/1/class/hlibrary.mk" ])))-                (D.compat . debInfo) ~= Just 9 -- This will change as new version of debhelper are released+                (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.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 ("9" :: String)))) Nothing],                                        [Rel (BinPkgName "haskell-devscripts") (Just (GRE (parseDebianVersion ("0.9" :: String)))) Nothing],@@ -175,7 +174,7 @@                               -- inputCabalization top                               finalizeDebianization)                           atoms-                 diff <- diffDebianizations (getL debInfo (expect atoms)) (getL debInfo deb)+                 diff <- diffDebianizations (view debInfo (expect atoms)) (view debInfo deb)                  assertEqual label [] diff)     where       expect atoms =@@ -187,11 +186,11 @@                                                  "",                                                  "include /usr/share/cdbs/1/rules/debhelper.mk",                                                  "include /usr/share/cdbs/1/class/hlibrary.mk"])))-                (D.compat . debInfo) ~= Just 9+                (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.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],@@ -228,7 +227,7 @@               withCurrentDirectory top $               do atoms <- testAtoms                  deb <- (execCabalT (liftCabal inputDebianization) atoms)-                 diff <- diffDebianizations (getL debInfo (testDeb2 atoms)) (getL debInfo deb)+                 diff <- diffDebianizations (view debInfo (testDeb2 atoms)) (view debInfo deb)                  assertEqual label [] diff)     where       testDeb2 :: CabalInfo -> CabalInfo@@ -236,8 +235,8 @@           execCabalM             (do defaultAtoms                 newDebianization log (Just 7) (Just (StandardsVersion 3 9 4 Nothing))-                (debInfo . D.sourceFormat) ~= Just Native3-                (debInfo . D.rulesHead) ~=+                (debInfo . D.sourceFormat) .= Just Native3+                (debInfo . D.rulesHead) .=                                Just (Text.unlines  ["#!/usr/bin/make -f",                                                     "# -*- makefile -*-",                                                     "",@@ -282,20 +281,20 @@                                                     "\trm -f $(manpages)",                                                     "",                                                     ""])-                (debInfo . D.compat) ~= Just 9+                (debInfo . D.compat) .= Just 9                 (debInfo . D.copyright) %= (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"))-                (debInfo . D.control . S.source) ~= Just (SrcPkgName {unSrcPkgName = "haskell-devscripts"})-                (debInfo . D.control . S.maintainer) ~= Just (NameAddr {nameAddr_name = Just "Debian Haskell Group", nameAddr_addr = "pkg-haskell-maintainers@lists.alioth.debian.org"})-                (debInfo . D.control . S.uploaders) ~= [NameAddr {nameAddr_name = Just "Marco Silva", nameAddr_addr = "marcot@debian.org"},NameAddr {nameAddr_name = Just "Joachim Breitner", nameAddr_addr = "nomeata@debian.org"}]-                (debInfo . D.control . S.priority) ~= Just Extra-                (debInfo . D.control . S.section) ~= Just (MainSection "haskell")+                (debInfo . D.control . S.source) .= Just (SrcPkgName {unSrcPkgName = "haskell-devscripts"})+                (debInfo . D.control . S.maintainer) .= Just (NameAddr {nameAddr_name = Just "Debian Haskell Group", nameAddr_addr = "pkg-haskell-maintainers@lists.alioth.debian.org"})+                (debInfo . D.control . S.uploaders) .= [NameAddr {nameAddr_name = Just "Marco Silva", nameAddr_addr = "marcot@debian.org"},NameAddr {nameAddr_name = Just "Joachim Breitner", nameAddr_addr = "nomeata@debian.org"}]+                (debInfo . D.control . S.priority) .= Just Extra+                (debInfo . D.control . S.section) .= Just (MainSection "haskell")                 (debInfo . D.control . S.buildDepends) %= (++ [[Rel (BinPkgName {unBinPkgName = "debhelper"}) (Just (GRE (Debian.Version.parseDebianVersion ("7" :: String)))) Nothing]])                 (debInfo . D.control . S.buildDependsIndep) %=  (++ [[Rel (BinPkgName {unBinPkgName = "perl"}) Nothing Nothing]])-                (debInfo . D.control . S.standardsVersion) ~= Just (StandardsVersion 3 9 4 Nothing)+                (debInfo . D.control . S.standardsVersion) .= Just (StandardsVersion 3 9 4 Nothing)                 (debInfo . D.control . S.vcsFields) %= 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"])-                (debInfo . D.binaryDebDescription (BinPkgName "haskell-devscripts") . B.architecture)  ~= Just All-                (debInfo . D.binaryDebDescription (BinPkgName "haskell-devscripts") . B.description) ~=+                (debInfo . D.binaryDebDescription (BinPkgName "haskell-devscripts") . B.architecture)  .= Just All+                (debInfo . D.binaryDebDescription (BinPkgName "haskell-devscripts") . B.description) .=                    Just                      (intercalate "\n"   ["Tools to help Debian developers build Haskell packages",                                           " This package provides a collection of scripts to help build Haskell",@@ -307,7 +306,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."])-                (debInfo . D.binaryDebDescription (BinPkgName "haskell-devscripts") . B.relations . B.depends) ~=+                (debInfo . D.binaryDebDescription (BinPkgName "haskell-devscripts") . B.relations . B.depends) .=                      [ [Rel (BinPkgName {unBinPkgName = "dctrl-tools"}) Nothing Nothing]                      , [Rel (BinPkgName {unBinPkgName = "debhelper"}) Nothing Nothing]                      , [Rel (BinPkgName {unBinPkgName = "dh-buildinfo"}) Nothing Nothing]@@ -391,38 +390,38 @@                  atoms <- withCurrentDirectory inTop $ testAtoms                  old <- withCurrentDirectory outTop $ do                           execCabalT (liftCabal inputDebianization) atoms-                 let log = getL (debInfo . D.changelog) old+                 let log = view (debInfo . D.changelog) old                  new <- withCurrentDirectory inTop $ do                           execCabalT (debianize (defaultAtoms >> customize log)) atoms-                 diff <- diffDebianizations (getL debInfo old) (getL debInfo ({-copyFirstLogEntry old-} new))+                 diff <- diffDebianizations (view debInfo old) (view debInfo ({-copyFirstLogEntry old-} new))                  assertEqual label [] diff)     where       customize :: Maybe ChangeLog -> CabalT IO ()       customize log =-          do (debInfo . D.changelog) ~= log+          do (debInfo . D.changelog) .= 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"))-             (A.debInfo . D.revision) ~= Nothing-             (A.debInfo . D.missingDependencies) += (BinPkgName "libghc-clckwrks-theme-clckwrks-doc")-             (A.debInfo . D.sourceFormat) ~= Just Native3-             (A.debInfo . D.control . S.homepage) ~= Just "http://www.clckwrks.com/"+             (A.debInfo . D.revision) .= Nothing+             (A.debInfo . D.missingDependencies) %= Set.insert (BinPkgName "libghc-clckwrks-theme-clckwrks-doc")+             (A.debInfo . D.sourceFormat) .= Just Native3+             (A.debInfo . D.control . S.homepage) .= Just "http://www.clckwrks.com/"              newDebianization' (Just 9) (Just (StandardsVersion 3 9 6 Nothing)) {-       customize log = modifyM (lift . customize' log)       customize' :: Maybe ChangeLog -> CabalInfo -> IO CabalInfo       customize' log atoms =           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 .+          over T.control (\ y -> y {T.homepage = Just "http://www.clckwrks.com/"}) .+          set T.sourceFormat (Just Native3) .+          over T.missingDependencies (insert (BinPkgName "libghc-clckwrks-theme-clckwrks-doc")) .+          set T.revision Nothing .           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 .           execCabalM tight .-          setL T.changelog log+          set T.changelog log -}       -- A log entry gets added when the Debianization is generated,       -- it won't match so drop it for the comparison.@@ -498,41 +497,41 @@                      outTop = "test-data/creativeprompts/output"                  atoms <- withCurrentDirectory inTop testAtoms                  old <- withCurrentDirectory outTop $ newFlags >>= execDebianT inputDebianization . D.makeDebInfo-                 let standards = getL (D.control . S.standardsVersion) old-                     level = getL D.compat old+                 let standards = view (D.control . S.standardsVersion) old+                     level = view D.compat old                  new <- withCurrentDirectory inTop (execCabalT (debianize (defaultAtoms >> customize old level standards)) atoms)-                 diff <- diffDebianizations old (getL debInfo new)+                 diff <- diffDebianizations old (view debInfo new)                  assertEqual label [] diff)     where       customize old level standards =-          do (A.debInfo . D.utilsPackageNameBase) ~= Just "creativeprompts-data"+          do (A.debInfo . D.utilsPackageNameBase) .= Just "creativeprompts-data"              newDebianization' level standards-             (debInfo . D.changelog) ~= (getL D.changelog old)+             (debInfo . D.changelog) .= (view 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"-             (A.debInfo . D.execMap) ++= ("trhsx", [[Rel (BinPkgName "haskell-hsx-utils") Nothing Nothing]])+             (A.debInfo . D.execMap) %= Map.insert "trhsx" [[Rel (BinPkgName "haskell-hsx-utils") Nothing Nothing]]              mapM_ (\ b -> (debInfo . D.binaryDebDescription b . B.relations . B.depends) %= \ deps -> deps ++ [[anyrel (BinPkgName "markdown")]])                    [(BinPkgName "creativeprompts-production"), (BinPkgName "creativeprompts-development")]-             (debInfo . D.binaryDebDescription (BinPkgName "creativeprompts-development") . B.description) ~=+             (debInfo . D.binaryDebDescription (BinPkgName "creativeprompts-development") . B.description) .=                    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." ])-             (debInfo . D.binaryDebDescription (BinPkgName "creativeprompts-data") . B.description) ~=+             (debInfo . D.binaryDebDescription (BinPkgName "creativeprompts-data") . B.description) .=                    Just (intercalate "\n" [ "creativeprompts.com data files"                                             , "  Static data files for creativeprompts.com"])-             (debInfo . D.binaryDebDescription (BinPkgName "creativeprompts-production") . B.description) ~=+             (debInfo . D.binaryDebDescription (BinPkgName "creativeprompts-production") . B.description) .=                    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." ])-             (debInfo . D.binaryDebDescription (BinPkgName "creativeprompts-backups") . B.description) ~=+             (debInfo . D.binaryDebDescription (BinPkgName "creativeprompts-backups") . B.description) .=                    Just (intercalate "\n" [ "backup program for creativeprompts.com"                                             , "  Install this somewhere other than creativeprompts.com to run automated"                                             , "  backups of the database."])-             (debInfo . D.binaryDebDescription (BinPkgName "creativeprompts-production") . B.architecture) ~= Just All-             (debInfo . D.binaryDebDescription (BinPkgName "creativeprompts-data") . B.architecture) ~= Just All-             (debInfo . D.binaryDebDescription (BinPkgName "creativeprompts-development") . B.architecture) ~= Just All-             (debInfo . D.sourceFormat) ~= Just Native3+             (debInfo . D.binaryDebDescription (BinPkgName "creativeprompts-production") . B.architecture) .= Just All+             (debInfo . D.binaryDebDescription (BinPkgName "creativeprompts-data") . B.architecture) .= Just All+             (debInfo . D.binaryDebDescription (BinPkgName "creativeprompts-development") . B.architecture) .= Just All+             (debInfo . D.sourceFormat) .= Just Native3        theSite :: BinPkgName -> D.Site       theSite deb =@@ -587,7 +586,7 @@ test7 label =     TestLabel label $     TestCase (do new <- readProcessWithExitCode "runhaskell" ["--ghc-arg=-package-db=dist/package.conf.inplace", "debian/Debianize.hs", "--dry-run", "--native"] ""-                 assertEqual label (ExitSuccess, "Ignored debianization file: debian/cabal-debian.1\nIgnored debianization file: debian/cabal-debian.manpages\nDebianization (dry run):\ndebian/cabal-debian-tests.install: Deleted\n\n", "") new)+                 assertEqual label (ExitSuccess, "Ignored debianization file: debian/cabal-debian.1\nIgnored debianization file: debian/cabal-debian.manpages\nDebianization (dry run):\n  No changes\n\n", "") new)  test8 :: String -> Test test8 label =@@ -595,18 +594,18 @@     TestCase ( do let inTop = "test-data/artvaluereport-data/input"                       outTop = "test-data/artvaluereport-data/output"                   (old :: D.DebInfo) <- withCurrentDirectory outTop $ newFlags >>= execDebianT inputDebianization . D.makeDebInfo-                  let log = getL D.changelog old+                  let log = view D.changelog old                   new <- withCurrentDirectory inTop $ newFlags >>= newCabalInfo >>= execCabalT (debianize (defaultAtoms >> customize log))-                  diff <- diffDebianizations old (getL debInfo new)+                  diff <- diffDebianizations old (view debInfo new)                   assertEqual label [] diff              )     where       customize Nothing = error "Missing changelog"       customize (Just log) =           do (debInfo . D.control . S.buildDepends) %= (++ [[Rel (BinPkgName "haskell-hsx-utils") Nothing Nothing]])-             (debInfo . D.control . S.homepage) ~= Just "http://artvaluereportonline.com"-             (debInfo . D.sourceFormat) ~= Just Native3-             (debInfo . D.changelog) ~= Just log+             (debInfo . D.control . S.homepage) .= Just "http://artvaluereportonline.com"+             (debInfo . D.sourceFormat) .= Just Native3+             (debInfo . D.changelog) .= Just log              newDebianization' (Just 9) (Just (StandardsVersion 3 9 6 Nothing))  test9 :: String -> Test@@ -615,9 +614,9 @@     TestCase (do let inTop = "test-data/alex/input"                      outTop = "test-data/alex/output"                  new <- withCurrentDirectory inTop $ newFlags >>= newCabalInfo >>= execCabalT (debianize (defaultAtoms >> customize))-                 let Just (ChangeLog (entry : _)) = getL (debInfo . D.changelog) new+                 let Just (ChangeLog (entry : _)) = view (debInfo . D.changelog) new                  old <- withCurrentDirectory outTop $ newFlags >>= execDebianT (inputDebianization >> copyChangelogDate (logDate entry)) . D.makeDebInfo-                 diff <- diffDebianizations old (getL debInfo new)+                 diff <- diffDebianizations old (view debInfo new)                  assertEqual label [] diff)     where       customize =@@ -637,13 +636,13 @@                    , "AlexWrapper-posn"                    , "AlexWrapper-posn-bytestring"                    , "AlexWrapper-strict-bytestring"]-             (debInfo . D.control . S.homepage) ~= Just "http://www.haskell.org/alex/"-             (debInfo . D.sourceFormat) ~= Just Native3-             (debInfo . D.debVersion) ~= Just (parseDebianVersion ("3.0.2-1~hackage1" :: String))+             (debInfo . D.control . S.homepage) .= Just "http://www.haskell.org/alex/"+             (debInfo . D.sourceFormat) .= Just Native3+             (debInfo . D.debVersion) .= Just (parseDebianVersion ("3.0.2-1~hackage1" :: String))              doExecutable (BinPkgName "alex")                           (D.InstallFile {D.execName = "alex", D.destName = "alex", D.sourceDir = Nothing, D.destDir = Nothing})              -- Bootstrap self-dependency-             (debInfo . D.allowDebianSelfBuildDeps) ~= True+             (debInfo . D.allowDebianSelfBuildDeps) .= True              (debInfo . D.control . S.buildDepends) %= (++ [[Rel (BinPkgName "alex") Nothing Nothing]])  test10 :: String -> Test@@ -652,21 +651,21 @@     TestCase (do let inTop = "test-data/archive/input"                      outTop = "test-data/archive/output"                  old <- withCurrentDirectory outTop $ newFlags >>= execDebianT inputDebianization . D.makeDebInfo-                 let Just (ChangeLog (entry : _)) = getL D.changelog old+                 let Just (ChangeLog (entry : _)) = view D.changelog old                  new <- withCurrentDirectory inTop $ newFlags >>= newCabalInfo >>= execCabalT (debianize (defaultAtoms >> customize >> (liftCabal $ copyChangelogDate $ logDate entry)))-                 diff <- diffDebianizations old (getL debInfo new)+                 diff <- diffDebianizations old (view debInfo new)                  assertEqual label [] diff)     where       customize :: CabalT IO ()       customize =-          do (A.debInfo . D.sourceFormat) ~= Just Native3-             (A.debInfo . D.sourcePackageName) ~= Just (SrcPkgName "seereason-darcs-backups")-             (A.debInfo . D.compat) ~= Just 9-             (A.debInfo . D.control . S.standardsVersion) ~= Just (StandardsVersion 3 8 1 Nothing)-             (A.debInfo . D.control . S.maintainer) ~= either (const Nothing) Just (parseMaintainer "David Fox <dsf@seereason.com>")+          do (A.debInfo . D.sourceFormat) .= Just Native3+             (A.debInfo . D.sourcePackageName) .= Just (SrcPkgName "seereason-darcs-backups")+             (A.debInfo . D.compat) .= Just 9+             (A.debInfo . D.control . S.standardsVersion) .= Just (StandardsVersion 3 8 1 Nothing)+             (A.debInfo . D.control . S.maintainer) .= either (const Nothing) Just (parseMaintainer "David Fox <dsf@seereason.com>")              (A.debInfo . D.binaryDebDescription (BinPkgName "seereason-darcs-backups") . B.relations . B.depends) %= (++ [[Rel (BinPkgName "anacron") Nothing Nothing]])-             (A.debInfo . D.control . S.section) ~= Just (MainSection "haskell")-             (A.debInfo . D.utilsPackageNameBase) ~= Just "seereason-darcs-backups"+             (A.debInfo . D.control . S.section) .= Just (MainSection "haskell")+             (A.debInfo . D.utilsPackageNameBase) .= Just "seereason-darcs-backups"              (A.debInfo . D.atomSet) %= (Set.insert $ D.InstallCabalExec (BinPkgName "seereason-darcs-backups") "seereason-darcs-backups" "/etc/cron.hourly")  copyChangelogDate :: Monad m => String -> DebianT m ()@@ -713,7 +712,7 @@                      (getContextDiff 2 (split (== '\n') a) (split (== '\n') b))  sortBinaryDebs :: DebianT IO ()-sortBinaryDebs = (D.control . S.binaryPackages) %= sortBy (compare `on` getL B.package)+sortBinaryDebs = (D.control . S.binaryPackages) %= sortBy (compare `on` view B.package)  main :: IO () main = runTestTT tests >>= putStrLn . show
cabal-debian.cabal view
@@ -1,5 +1,5 @@ Name:           cabal-debian-Version:        4.26+Version:        4.27 Copyright:      Copyright (c) 2007-2014, David Fox, Jeremy Shaw License:        BSD3 License-File:   LICENSE@@ -210,7 +210,6 @@     Debian.Debianize.Prelude     Debian.Debianize.SourceDebDescription     Debian.Debianize.VersionSplits-    OldLens     Paths_cabal_debian   Other-Modules:     Debian.Orphans
changelog view
@@ -1,3 +1,49 @@+haskell-cabal-debian (4.27) unstable; urgency=low++  * Remove all vestiges of the old data-lens package.  Thanks to+    Dmitry Bogatov for help with this.++ -- David Fox <dsf@seereason.com>  Fri, 17 Apr 2015 15:01:27 -0700++haskell-cabal-debian (4.26) unstable; urgency=low++  * Revamp the way the final debian version number is computed in+    Debian.Debianize.Finalize.debianVersion.++ -- David Fox <dsf@seereason.com>  Sun, 05 Apr 2015 10:49:33 -0700++haskell-cabal-debian (4.25) unstable; urgency=low++  * Make sure /proc is mounted when we run ghc to determine its version+    number.  This is only a concern when running in a build root.+  * Fix whitespace handling bugs in copyright file parser and renderer.++ -- David Fox <dsf@seereason.com>  Sun, 05 Apr 2015 08:14:09 -0700++haskell-cabal-debian (4.24.9) unstable; urgency=low++  * Make debian/Debianize.hs a standard debianization script+  * Make the test executable into a cabal test suite+  * Make ghc-7.10 support official+  * Simplify main in CabalDebian.hs+  * Get rid of old --substvars option++ -- David Fox <dsf@seereason.com>  Wed, 01 Apr 2015 10:00:45 -0700++haskell-cabal-debian (4.24.8) unstable; urgency=low++  * use ghcjs --numeric-ghc-version to set the compilerInfoCompat field+    of CompilerInfo.  This makes cabal file directives like impl(ghc >= 7.9)+    work for ghcjs packages.++ -- David Fox <dsf@seereason.com>  Sun, 29 Mar 2015 12:38:33 -0700++haskell-cabal-debian (4.24.7) unstable; urgency=low++  * Remove the Data.Algorithm.Diff modules, they have moved into Diff-0.3.1++ -- David Fox <dsf@seereason.com>  Tue, 24 Mar 2015 16:51:29 -0700+ haskell-cabal-debian (4.24.6) unstable; urgency=low    * Use build dependency haskell-devscripts >= 0.8 for unofficial, >= 0.9
debian/Debianize.hs view
@@ -1,6 +1,7 @@ -- To run the test: runhaskell --ghc-arg=-package-db=dist/package.conf.inplace debian/Debianize.hs --dry-run  import Control.Exception (throw)+import Control.Lens import Control.Monad.State (evalStateT) import Data.Map as Map (insert) import Data.Set as Set (insert)@@ -27,15 +28,15 @@              -- changing as new package versions arrive.              mapCabal (PackageName "Cabal") (DebBase "cabal-122")              splitCabal (PackageName "Cabal") (DebBase "cabal") (Version [1,22] [])-             (debInfo . sourceFormat) ~= Just Native3-             (debInfo . control . standardsVersion) ~= Just (StandardsVersion 3 9 3 Nothing)-             (debInfo . compat) ~= Just 9-             (debInfo . utilsPackageNameBase) ~= Just "cabal-debian"+             (debInfo . sourceFormat) .= Just Native3+             (debInfo . control . standardsVersion) .= Just (StandardsVersion 3 9 3 Nothing)+             (debInfo . compat) .= Just 9+             (debInfo . utilsPackageNameBase) .= Just "cabal-debian"              (debInfo . binaryDebDescription (BinPkgName "cabal-debian") . relations . depends) %= (++ (rels "apt-file, debian-policy, debhelper, haskell-devscripts (>= 0.8.19)"))              (debInfo . binaryDebDescription (BinPkgName "libghc-cabal-debian-dev") . relations . depends) %= (++ (rels "debian-policy"))              (debInfo . atomSet) %= (Set.insert $ InstallCabalExec (BinPkgName "cabal-debian") "cabal-debian" "usr/bin")-             (debInfo . utilsPackageNameBase) ~= Just "cabal-debian"-             (debInfo . control . homepage) ~= Just (pack "https://github.com/ddssff/cabal-debian")+             (debInfo . utilsPackageNameBase) .= Just "cabal-debian"+             (debInfo . control . homepage) .= Just (pack "https://github.com/ddssff/cabal-debian")  rels :: String -> Relations rels = either (throw . userError . show) id . parseRelations
debian/changelog view
@@ -1,3 +1,10 @@+haskell-cabal-debian (4.27) unstable; urgency=low++  * Remove all vestiges of the old data-lens package.  Thanks to+    Dmitry Bogatov for help with this.++ -- David Fox <dsf@seereason.com>  Fri, 17 Apr 2015 15:01:27 -0700+ haskell-cabal-debian (4.26) unstable; urgency=low    * Revamp the way the final debian version number is computed in
src/Debian/Debianize.hs view
@@ -76,30 +76,6 @@ -- entire pipeline when it finds from a script found in a -- debian/Debianize.hs file. -{--   Types.hs-   Monad.hs-   Lenses.hs--   Input.hs-- * Files.hs--   Output.hs--   Bundled.hs-   Changelog.hs-   DebianName.hs-   Details.hs-   Finalize.hs-   Goodies.hs-   Interspersed.hs-   Options.hs-   SubstVars.hs-   Tests.hs-   Utility.hs-   VersionSplits.hs--} module Debian.Debianize     ( -- * Collect information about desired debianization       module Debian.Debianize.BasicInfo@@ -128,49 +104,7 @@     , module Debian.Debianize.Prelude     , module Debian.Debianize.VersionSplits     , module Debian.Policy-{--    , Debian.Debianize.Finalize.debianize-    , Debian.Debianize.Finalize.finalizeDebianization -    , Debian.Debianize.Output.doDebianizeAction-    , Debian.Debianize.Output.runDebianizeScript-    , Debian.Debianize.Output.writeDebianization-    , Debian.Debianize.Output.describeDebianization-    , Debian.Debianize.Output.compareDebianization-    , Debian.Debianize.Output.validateDebianization--    , Debian.Debianize.Details.debianDefaultAtoms--    , Debian.Debianize.Goodies.tightDependencyFixup-    , Debian.Debianize.Goodies.doExecutable-    , Debian.Debianize.Goodies.doServer-    , Debian.Debianize.Goodies.doWebsite-    , Debian.Debianize.Goodies.doBackups--    , Debian.Debianize.InputDebian.inputDebianization-    , Debian.Debianize.InputDebian.inputDebianizationFile-    , Debian.Debianize.InputDebian.inputChangeLog--    , Debian.Debianize.DebianName.mapCabal-    , Debian.Debianize.DebianName.splitCabal-    , Debian.Debianize.Options.compileArgs-    , Debian.Debianize.SubstVars.substvars--    -- * Utility functions--    , Debian.Debianize.Prelude.withCurrentDirectory-    , Debian.Debianize.Prelude.buildDebVersionMap-    , Debian.Debianize.Prelude.dpkgFileMap-    , Debian.Debianize.Prelude.debOfFile-    -- * Lens operators-    , (~=)-    , (~?=)-    , (%=)-    , (+=)-    , (++=)-    , (+++=)---}     ) where  import Debian.Debianize.CabalInfo -- (debianNameMap, debInfo, epochMap, newAtoms, packageDescription, PackageInfo, packageInfo, showAtoms)@@ -187,7 +121,7 @@ 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, finishDebianization, runDebianizeScript, validateDebianization, writeDebianization)-import Debian.Debianize.Prelude ((%=), (+++=), (++=), (+=), buildDebVersionMap, debOfFile, dpkgFileMap, withCurrentDirectory, (~=), (~?=))+import Debian.Debianize.Prelude (buildDebVersionMap, debOfFile, dpkgFileMap, withCurrentDirectory, (.?=)) import Debian.Debianize.SourceDebDescription 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)
src/Debian/Debianize/BasicInfo.hs view
@@ -20,20 +20,19 @@     ) where  import Control.Applicative ((<$>))-import Control.Category ((.))+import Control.Lens 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 Control.Lens.TH (makeLenses) import Data.Monoid (Monoid(..)) import Data.Set as Set (fromList, Set, union)-import Debian.Debianize.Prelude ((%=), read', (~=))+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 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 ((</>))@@ -103,28 +102,28 @@ -- 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")+    [ 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))+      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))+      Option "h?" ["help"] (NoArg (debAction .= Usage))              "Show this help text",-      Option "" ["ghc"] (NoArg (compilerFlavor ~= GHC)) "Generate packages for GHC - same as --with-compiler GHC",+      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",+      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 "" ["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)+                                                        (\ 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))+      Option "" ["debianize"] (NoArg (debAction .= Debianize))              "Deprecated - formerly used to get what is now the normal benavior.",-      Option "" ["buildenvdir"] (ReqArg (\ s -> buildEnv ~= EnvSet {cleanOS = s </> "clean", dependOS = s </> "depend", buildOS = s </> "build"}) "PATH")+      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 "
src/Debian/Debianize/BuildDependencies.hs view
@@ -5,10 +5,9 @@     , debianBuildDepsIndep     ) where -import OldLens (access, getL)  import Control.Applicative ((<$>))-import Control.Category ((.))+import Control.Lens import Control.Monad.State (MonadState(get)) import Control.Monad.Trans (MonadIO) import Data.Char (isSpace, toLower)@@ -39,7 +38,7 @@ 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)@@ -76,7 +75,7 @@ -- so we just gather them all up here. allBuildDepends :: Monad m => PackageDescription -> CabalT m [Dependency_] allBuildDepends pkgDesc =-    access (A.debInfo . D.enableTests) >>= \ testsEnabled ->+    use (A.debInfo . D.enableTests) >>= \ testsEnabled ->     allBuildDepends'       (mergeCabalDependencies $        Cabal.buildDepends pkgDesc ++@@ -98,7 +97,7 @@       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 (A.debInfo . D.extraLibMap) atoms))) xs+                                        (Map.lookup cab (view (A.debInfo . D.extraLibMap) atoms))) xs  -- | Take the intersection of all the dependencies on a given package name mergeCabalDependencies :: [Dependency] -> [Dependency]@@ -111,16 +110,16 @@ -- the rules for building haskell packages. debianBuildDeps :: (MonadIO m, Functor m) => PackageDescription -> CabalT m D.Relations debianBuildDeps pkgDesc =-    do hc <- access (A.debInfo . D.flags . compilerFlavor)+    do hc <- use (A.debInfo . D.flags . compilerFlavor)        let hcs = singleton hc -- vestigial        let hcTypePairs =                fold union empty $                   Set.map (\ hc' -> Set.map (hc',) $ hcPackageTypes hc') hcs        cDeps <- allBuildDepends pkgDesc >>= mapM (buildDependencies hcTypePairs) >>= return . {-nub .-} concat-       bDeps <- access (A.debInfo . D.control . S.buildDepends)-       prof <- not <$> access (A.debInfo . D.noProfilingLibrary)-       official <- access (A.debInfo . D.official)-       compat <- access (A.debInfo . D.compat)+       bDeps <- use (A.debInfo . D.control . S.buildDepends)+       prof <- not <$> use (A.debInfo . D.noProfilingLibrary)+       official <- use (A.debInfo . D.official)+       compat <- use (A.debInfo . D.compat)        let xs = nub $ [maybe [] (\ n -> [D.Rel (D.BinPkgName "debhelper") (Just (D.GRE (parseDebianVersion (show n)))) Nothing]) compat,                        [D.Rel (D.BinPkgName "haskell-devscripts") (Just $ D.GRE $ parseDebianVersion $ if official then "0.9" else "0.8" :: String) Nothing],                        anyrel "cdbs"] ++@@ -144,10 +143,10 @@  debianBuildDepsIndep :: (MonadIO m, Functor m) => PackageDescription -> CabalT m D.Relations debianBuildDepsIndep pkgDesc =-    do hc <- access (A.debInfo . D.flags . compilerFlavor)+    do hc <- use (A.debInfo . D.flags . compilerFlavor)        let hcs = singleton hc -- vestigial-       doc <- not <$> access (A.debInfo . D.noDocumentationLibrary)-       bDeps <- access (A.debInfo . D.control . S.buildDependsIndep)+       doc <- not <$> use (A.debInfo . D.noDocumentationLibrary)+       bDeps <- use (A.debInfo . D.control . S.buildDependsIndep)        cDeps <- allBuildDepends pkgDesc >>= mapM docDependencies        let xs = nub $ if doc                       then (if member GHC hcs then [anyrel' (compilerPackageName GHC B.Documentation)] else []) ++@@ -160,12 +159,12 @@  -- | 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.+-- dependencies, so we have use to all the cross references. docDependencies :: (MonadIO m, Functor m) => Dependency_ -> CabalT m D.Relations docDependencies (BuildDepends (Dependency name ranges)) =-    do hc <- access (A.debInfo . D.flags . compilerFlavor)+    do hc <- use (A.debInfo . D.flags . compilerFlavor)        let hcs = singleton hc -- vestigial-       omitProfDeps <- access (A.debInfo . D.omitProfVersionDeps)+       omitProfDeps <- use (A.debInfo . D.omitProfVersionDeps)        concat <$> mapM (\ hc' -> dependencies hc' B.Documentation name ranges omitProfDeps) (toList hcs) docDependencies _ = return [] @@ -174,15 +173,15 @@ -- references.  Also the packages associated with extra libraries. buildDependencies :: (MonadIO m, Functor m) => Set (CompilerFlavor, B.PackageType) -> Dependency_ -> CabalT m D.Relations buildDependencies hcTypePairs (BuildDepends (Dependency name ranges)) =-    access (A.debInfo . D.omitProfVersionDeps) >>= \ omitProfDeps ->+    use (A.debInfo . D.omitProfVersionDeps) >>= \ omitProfDeps ->     concat <$> mapM (\ (hc, typ) -> dependencies hc typ name ranges omitProfDeps) (toList hcTypePairs) buildDependencies _ dep@(ExtraLibs _) =-    do mp <- access (A.debInfo . D.execMap)+    do mp <- use (A.debInfo . D.execMap)        return $ concat $ adapt mp dep buildDependencies _ dep =     case unboxDependency dep of       Just (Dependency _name _ranges) ->-          do mp <- get >>= return . getL (A.debInfo . D.execMap)+          do mp <- get >>= return . view (A.debInfo . D.execMap)              return $ concat $ adapt mp dep       Nothing ->           return []@@ -229,7 +228,7 @@ -- so we will return just an OrRelation. dependencies :: MonadIO m => CompilerFlavor -> B.PackageType -> PackageName -> VersionRange -> Bool -> CabalT m Relations dependencies hc typ name cabalRange omitProfVersionDeps =-    do nameMap <- access A.debianNameMap+    do nameMap <- use 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@@ -308,9 +307,9 @@       comp = D.Rel (compilerPackageName hc typ) Nothing Nothing       doRel :: MonadIO m => D.Relation -> CabalT m [D.Relation]       doRel rel@(D.Rel dname req _) = do-        -- gver <- access ghcVersion-        splits <- access A.debianNameMap-        root <- access (A.debInfo . D.flags . buildEnv) >>= return . dependOS+        -- gver <- use ghcVersion+        splits <- use A.debianNameMap+        root <- use (A.debInfo . D.flags . buildEnv) >>= 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?@@ -357,17 +356,17 @@     where       doRel :: MonadIO m => D.Relation -> CabalT m [D.Relation]       doRel rel@(D.Rel dname req _) = do-        hc <- access+        hc <- use -}  -- Convert a cabal version to a debian version, adding an epoch number if requested debianVersion' :: Monad m => PackageName -> Version -> CabalT m DebianVersion debianVersion' name v =     do atoms <- get-       return $ parseDebianVersion (maybe "" (\ n -> show n ++ ":") (Map.lookup name (getL A.epochMap atoms)) ++ showVersion v)+       return $ parseDebianVersion (maybe "" (\ n -> show n ++ ":") (Map.lookup name (view A.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)+debianVersion'' atoms name v = parseDebianVersion (maybe "" (\ n -> show n ++ ":") (Map.lookup name (view A.epochMap atoms)) ++ showVersion v)  data Rels a = And {unAnd :: [Rels a]} | Or {unOr :: [Rels a]} | Rel' {unRel :: a} deriving Show @@ -383,4 +382,4 @@ 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 (A.debInfo . D.missingDependencies) atoms)))) rels)+    List.filter (/= []) (List.map (List.filter (\ (Rel name _ _) -> not (Set.member name (view (A.debInfo . D.missingDependencies) atoms)))) rels)
src/Debian/Debianize/CabalInfo.hs view
@@ -17,8 +17,7 @@     , newCabalInfo     ) where -import Control.Category ((.))-import Control.Lens.TH (makeLenses)+import Control.Lens import Control.Monad.Catch (MonadMask) import Control.Monad.State (execStateT) import Control.Monad.Trans (MonadIO, liftIO)@@ -31,7 +30,6 @@ 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 ()@@ -39,7 +37,7 @@ import Debian.Version (DebianVersion) import Distribution.Package (PackageName) import Distribution.PackageDescription as Cabal (PackageDescription(homepage))-import Prelude hiding ((.), init, init, log, log, null)+import Prelude hiding (init, init, log, log, null) import System.Unix.Mount (withProcAndSys)  -- This enormous record is a mistake - instead it should be an Atom@@ -90,8 +88,8 @@   pkgDesc <- inputCabalization flags'   copyrt <- liftIO $ defaultCopyrightDescription pkgDesc   execStateT-    (do (debInfo . copyright) ~= Just copyrt-        (debInfo . control . S.homepage) ~= case strip (pack (Cabal.homepage pkgDesc)) of+    (do (debInfo . copyright) .= Just copyrt+        (debInfo . control . S.homepage) .= case strip (pack (Cabal.homepage pkgDesc)) of                                               x | Text.null x -> Nothing                                               x -> Just x)     (makeCabalInfo flags' pkgDesc)
src/Debian/Debianize/CopyrightDescription.hs view
@@ -51,6 +51,7 @@ import Prelude hiding (init, init, log, log, unlines, readFile) import Text.PrettyPrint.HughesPJClass (Pretty(pPrint), text) +unPackageName :: Cabal.PackageName -> String unPackageName (Cabal.PackageName x) = x  -- | Description of the machine readable debian/copyright file.  A
src/Debian/Debianize/DebInfo.hs view
@@ -87,13 +87,9 @@     , makeDebInfo     ) where -import OldLens (Lens, iso, getL, (%=))--import Control.Category ((.))+import Control.Lens import Control.Monad.State (StateT)---import Data.Default (def) import Data.Generics (Data, Typeable)-import Control.Lens.TH (makeLenses) import Data.Map as Map (Map) import Data.Monoid (Monoid(..)) import Data.Set as Set (insert, Set)@@ -109,7 +105,7 @@ 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 Prelude hiding (init, init, log, log) import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr)  -- | Information required to represent a non-cabal debianization.@@ -380,13 +376,13 @@  -- We need (%=_) link :: Monad m => BinPkgName -> FilePath -> FilePath -> StateT DebInfo m ()-link b from dest = atomSet %= (Set.insert $ Link b from dest) >> return ()+link b src dest = atomSet %= (Set.insert $ Link b src dest) >> return () install :: Monad m => BinPkgName -> FilePath -> FilePath -> StateT DebInfo m ()-install b from dest = atomSet %= (Set.insert $ Install b from dest) >> return ()+install b src dest = atomSet %= (Set.insert $ Install b src dest) >> return () installTo :: Monad m => BinPkgName -> FilePath -> FilePath -> StateT DebInfo m ()-installTo b from dest = atomSet %= (Set.insert $ InstallTo b from dest) >> return ()+installTo b src dest = atomSet %= (Set.insert $ InstallTo b src dest) >> return () installData :: Monad m => BinPkgName -> FilePath -> FilePath -> StateT DebInfo m ()-installData b from dest = atomSet %= (Set.insert $ InstallData b from dest) >> return ()+installData b src dest = atomSet %= (Set.insert $ InstallData b src 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 ()@@ -398,6 +394,6 @@  -- | 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 :: BinPkgName -> Lens' DebInfo BinaryDebDescription binaryDebDescription b =-    control . S.binaryPackages . listElemLens ((== b) . getL package) . maybeLens (newBinaryDebDescription b) (iso id id)+    control . S.binaryPackages . listElemLens ((== b) . view package) . maybeLens (newBinaryDebDescription b) (iso id id)
src/Debian/Debianize/DebianName.hs view
@@ -11,15 +11,13 @@     , remapCabal     ) where -import OldLens (access)  import Control.Applicative ((<$>))-import Control.Category ((.))+import Control.Lens import Data.Char (toLower) import Data.Map as Map (alter, lookup) import Data.Version (showVersion, Version) import Debian.Debianize.Monad (CabalT)-import Debian.Debianize.Prelude ((%=)) import Debian.Debianize.CabalInfo as A (debianNameMap, packageDescription, debInfo) import Debian.Debianize.BinaryDebDescription as Debian (PackageType(..)) import Debian.Debianize.DebInfo as D (overrideDebianNameBase, utilsPackageNameBase)@@ -31,7 +29,7 @@ import Distribution.Compiler (CompilerFlavor(..)) import Distribution.Package (Dependency(..), PackageIdentifier(..), PackageName(PackageName)) import qualified Distribution.PackageDescription as Cabal (PackageDescription(package))-import Prelude hiding (unlines, (.))+import Prelude hiding (unlines)  data Dependency_   = BuildDepends Dependency@@ -45,8 +43,8 @@ debianName typ cfl =     do base <-            case (typ, cfl) of-             (Utilities, GHC) -> access (debInfo . utilsPackageNameBase) >>= maybe (((\ base -> "haskell-" ++ base ++ "-utils") . unDebBase) <$> debianNameBase) return-             (Utilities, _) -> access (debInfo . utilsPackageNameBase) >>= maybe (((\ base -> base ++ "-utils") . unDebBase) <$> debianNameBase) return+             (Utilities, GHC) -> use (debInfo . utilsPackageNameBase) >>= maybe (((\ base -> "haskell-" ++ base ++ "-utils") . unDebBase) <$> debianNameBase) return+             (Utilities, _) -> use (debInfo . utilsPackageNameBase) >>= maybe (((\ base -> base ++ "-utils") . unDebBase) <$> debianNameBase) return              _ -> unDebBase <$> debianNameBase        return $ mkPkgName' cfl typ (DebBase base) @@ -56,10 +54,10 @@ -- is >= v. debianNameBase :: Monad m => CabalT m DebBase debianNameBase =-    do nameBase <- access (debInfo . D.overrideDebianNameBase)-       pkgDesc <- access packageDescription+    do nameBase <- use (debInfo . D.overrideDebianNameBase)+       pkgDesc <- use packageDescription        let pkgId = Cabal.package pkgDesc-       nameMap <- access A.debianNameMap+       nameMap <- use A.debianNameMap        let pname@(PackageName _) = pkgName pkgId            version = (Just (D.EEQ (parseDebianVersion (showVersion (pkgVersion pkgId)))))        case (nameBase, Map.lookup (pkgName pkgId) nameMap) of
src/Debian/Debianize/Details.hs view
@@ -6,17 +6,16 @@     ( debianDefaults     ) where -import Control.Category ((.))+import Control.Lens+import Data.Map as Map (insert) import Data.Version (Version(Version)) 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 CabalInfo value in the CabalT state with some details about -- the debian repository - special cases for how some cabal packages@@ -24,10 +23,10 @@ debianDefaults :: Monad m => CabalT m () debianDefaults =     do -- These are the two epoch names I know about in the debian repo-       A.epochMap ++= (PackageName "HaXml", 1)-       A.epochMap ++= (PackageName "HTTP", 1)+       A.epochMap %= Map.insert (PackageName "HaXml") 1+       A.epochMap %= Map.insert (PackageName "HTTP") 1        -- The hsx2hs build tool is in an an eponymous deb-       (A.debInfo . D.execMap) ++= ("hsx2hs", [[Rel (BinPkgName "hsx2hs") Nothing Nothing]])+       (A.debInfo . D.execMap) %= Map.insert "hsx2hs" [[Rel (BinPkgName "hsx2hs") Nothing Nothing]]        -- The parsec debs are suffixed with either "2" or "3"        mapCabal (PackageName "parsec") (DebBase "parsec3")        splitCabal (PackageName "parsec") (DebBase "parsec2") (Version [3] [])
src/Debian/Debianize/Files.hs view
@@ -6,10 +6,9 @@     ( debianizationFileMap     ) where -import OldLens (access, getL)  import Control.Applicative ((<$>))-import Control.Category ((.))+import Control.Lens import Control.Monad.Trans (lift) import Control.Monad.Writer (execWriterT, tell, WriterT) import Data.Char (isSpace)@@ -30,7 +29,7 @@ import Debian.Pretty (PP(..), ppShow, prettyText, ppText, ppPrint) import Debian.Relation (BinPkgName(BinPkgName), Relations) import Distribution.PackageDescription (PackageDescription)-import Prelude hiding ((.), dropWhile, init, log, unlines, writeFile)+import Prelude hiding (dropWhile, init, log, unlines, writeFile) import System.FilePath ((</>)) import Text.PrettyPrint.HughesPJClass (empty, Pretty(pPrint), text) @@ -70,25 +69,25 @@  sourceFormatFiles :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] sourceFormatFiles =-    maybe [] (\ x -> [("debian/source/format", pack (ppShow x))]) <$> (lift $ access D.sourceFormat)+    maybe [] (\ x -> [("debian/source/format", pack (ppShow x))]) <$> (lift $ use D.sourceFormat)  watchFile :: (Monad m, Functor m) => FilesT m [(FilePath, Text)]-watchFile = maybe [] (\ x -> [("debian/watch", x)]) <$> (lift $ access D.watch)+watchFile = maybe [] (\ x -> [("debian/watch", x)]) <$> (lift $ use D.watch)  intermediates :: (Monad m, Functor m) => FilesT m [(FilePath, Text)]-intermediates = Set.toList <$> (lift $ access D.intermediateFiles)+intermediates = Set.toList <$> (lift $ use D.intermediateFiles)  installs :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] installs =-    (Map.toList . Map.map unlines . Set.fold doAtom mempty) <$> (lift $ access (D.atomSet))+    (Map.toList . Map.map unlines . Set.fold doAtom mempty) <$> (lift $ use (D.atomSet))     where-      doAtom (D.Install b from dest) mp = Map.insertWith (++) (pathf b) [pack (from <> " " <> dest)] mp+      doAtom (D.Install b frm dst) mp = Map.insertWith (++) (pathf b) [pack (frm <> " " <> dst)] 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 D.atomSet)+    (Map.toList . Map.map unlines . Set.fold doAtom mempty) <$> (lift $ use D.atomSet)     where       doAtom (D.InstallDir b dir) mp = Map.insertWith (++) (pathf b) [pack dir] mp       doAtom _ mp = mp@@ -96,21 +95,21 @@  init :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] init =-    (Map.toList . mapKeys pathf) <$> (lift $ access D.installInit)+    (Map.toList . mapKeys pathf) <$> (lift $ use 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 D.logrotateStanza)+    (Map.toList . Map.map (\ stanzas -> Text.unlines (Set.toList stanzas)) . mapKeys pathf) <$> (lift $ use 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 D.atomSet)+    (Map.toList . Map.map unlines . Set.fold doAtom mempty) <$> (lift $ use D.atomSet)     where       doAtom (D.Link b loc t) mp = Map.insertWith (++) (pathf b) [pack loc <> " " <> pack t] mp       doAtom _ mp = mp@@ -118,54 +117,54 @@  postinstFiles :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] postinstFiles =-     (Map.toList . mapKeys pathf) <$> (lift $ access D.postInst)+     (Map.toList . mapKeys pathf) <$> (lift $ use 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 D.postRm)+    (Map.toList . mapKeys pathf) <$> (lift $ use 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 D.preInst)+    (Map.toList . mapKeys pathf) <$> (lift $ use 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 D.preRm)+    (Map.toList . mapKeys pathf) <$> (lift $ use 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 (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))+    do Just rh <- lift (use (D.rulesHead))+       rassignments <- lift (use (D.rulesSettings)) >>= return . intercalate "\n"+       rincludes <- lift (use (D.rulesIncludes)) >>= return . intercalate "\n"+       rl <- (reverse . Set.toList) <$> lift (use (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 D.changelog+    do log <- lift $ use 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 D.control+    do d <- lift $ use D.control        return [("debian/control", prettyText (controlFile d))]  compat :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] compat =-    do t <- lift $ access D.compat+    do t <- lift $ use 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 (D.copyright)+    do copyrt <- lift $ use (D.copyright)        return [("debian/copyright", prettyText copyrt)]  instance Pretty (PP (PackageDescription -> IO CopyrightDescription)) where@@ -176,41 +175,41 @@     Control     { unControl =           (Paragraph-           ([Field ("Source", " " ++ (show . maybe empty ppPrint . getL S.source $ src)),-             Field ("Maintainer", " " <> (show . maybe empty ppPrint . getL S.maintainer $ src))] ++-            lField "Uploaders" (getL S.uploaders src) ++-            (case getL S.dmUploadAllowed src of True -> [Field ("DM-Upload-Allowed", " yes")]; False -> []) ++-            mField "Priority" (getL S.priority src) ++-            mField "Section" (getL S.section src) ++-            depField "Build-Depends" (getL S.buildDepends src) ++-            depField "Build-Depends-Indep" (getL S.buildDependsIndep src) ++-            depField "Build-Conflicts" (getL S.buildConflicts src) ++-            depField "Build-Conflicts-Indep" (getL S.buildConflictsIndep src) ++-            mField "Standards-Version" (getL S.standardsVersion src) ++-            mField "Homepage" (getL S.homepage src) ++-            List.map vcsField (Set.toList (getL S.vcsFields src)) ++-            List.map xField (Set.toList (getL S.xFields src)) ++-            mField "X-Description" (getL S.xDescription src)) :-           List.map binary (getL S.binaryPackages src))+           ([Field ("Source", " " ++ (show . maybe empty ppPrint . view S.source $ src)),+             Field ("Maintainer", " " <> (show . maybe empty ppPrint . view S.maintainer $ src))] +++            lField "Uploaders" (view S.uploaders src) +++            (case view S.dmUploadAllowed src of True -> [Field ("DM-Upload-Allowed", " yes")]; False -> []) +++            mField "Priority" (view S.priority src) +++            mField "Section" (view S.section src) +++            depField "Build-Depends" (view S.buildDepends src) +++            depField "Build-Depends-Indep" (view S.buildDependsIndep src) +++            depField "Build-Conflicts" (view S.buildConflicts src) +++            depField "Build-Conflicts-Indep" (view S.buildConflictsIndep src) +++            mField "Standards-Version" (view S.standardsVersion src) +++            mField "Homepage" (view S.homepage src) +++            List.map vcsField (Set.toList (view S.vcsFields src)) +++            List.map xField (Set.toList (view S.xFields src)) +++            mField "X-Description" (view S.xDescription src)) :+           List.map binary (view S.binaryPackages src))     }     where       binary :: B.BinaryDebDescription -> Paragraph' String       binary bin =           Paragraph-           ([Field ("Package", " " ++ (show . ppPrint . getL B.package $ bin)),-             Field ("Architecture", " " ++ (show . maybe empty ppPrint . getL B.architecture $ bin))] ++-            mField "Section" (getL B.binarySection bin) ++-            mField "Priority" (getL B.binaryPriority bin) ++-            mField "Essential" (getL B.essential bin) ++-            relFields (getL B.relations bin) ++-            [Field ("Description", " " ++ (unpack . ensureDescription . fromMaybe mempty . getL B.description $ bin))])+           ([Field ("Package", " " ++ (show . ppPrint . view B.package $ bin)),+             Field ("Architecture", " " ++ (show . maybe empty ppPrint . view B.architecture $ bin))] +++            mField "Section" (view B.binarySection bin) +++            mField "Priority" (view B.binaryPriority bin) +++            mField "Essential" (view B.essential bin) +++            relFields (view B.relations bin) +++            [Field ("Description", " " ++ (unpack . ensureDescription . fromMaybe mempty . view B.description $ bin))])           where             ensureDescription t =                 case List.dropWhileEnd Text.null (List.dropWhile Text.null (List.map (Text.dropWhileEnd isSpace) (Text.lines t))) of-                  [] -> "WARNING: No description available for package " <> ppText (getL B.package bin)+                  [] -> "WARNING: No description available for package " <> ppText (view B.package bin)                   (short : long) ->                       Text.intercalate "\n"-                        ((if Text.null (Text.dropWhile isSpace short) then ("WARNING: No short description available for package " <> ppText (getL B.package bin)) else short) : long)+                        ((if Text.null (Text.dropWhile isSpace short) then ("WARNING: No short description available for package " <> ppText (view B.package bin)) else short) : long)       mField tag = maybe [] (\ x -> [Field (tag, " " <> (show . ppPrint $ x))])       lField _ [] = []       lField tag xs = [Field (tag, " " <> (show . ppPrint $ xs))]@@ -230,15 +229,15 @@  relFields :: B.PackageRelations -> [Field' [Char]] relFields rels =-    depField "Depends" (getL B.depends rels) ++-    depField "Recommends" (getL B.recommends rels) ++-    depField "Suggests" (getL B.suggests rels) ++-    depField "Pre-Depends" (getL B.preDepends rels) ++-    depField "Breaks" (getL B.breaks rels) ++-    depField "Conflicts" (getL B.conflicts rels) ++-    depField "Provides" (getL B.provides rels) ++-    depField "Replaces" (getL B.replaces rels) ++-    depField "Built-Using" (getL B.builtUsing rels)+    depField "Depends" (view B.depends rels) +++    depField "Recommends" (view B.recommends rels) +++    depField "Suggests" (view B.suggests rels) +++    depField "Pre-Depends" (view B.preDepends rels) +++    depField "Breaks" (view B.breaks rels) +++    depField "Conflicts" (view B.conflicts rels) +++    depField "Provides" (view B.provides rels) +++    depField "Replaces" (view B.replaces rels) +++    depField "Built-Using" (view B.builtUsing rels)  depField :: [Char] -> Relations -> [Field' [Char]] depField tag rels = case rels of [] -> []; _ -> [Field (tag, " " ++ showDeps' rels)]
src/Debian/Debianize/Finalize.hs view
@@ -1,14 +1,13 @@ -- | Compute the debianization of a cabal package.-{-# LANGUAGE CPP, FlexibleInstances, OverloadedStrings, ScopedTypeVariables #-}+{-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances, OverloadedStrings, ScopedTypeVariables #-} module Debian.Debianize.Finalize     ( debianize     -- , finalizeDebianization -- external use deprecated - used in test script     ) where -import OldLens (access, getL)  import Control.Applicative ((<$>))-import Control.Category ((.))+import Control.Lens hiding ((<.>)) import Control.Monad (unless, when) import Control.Monad as List (mapM_) import Control.Monad.State (get, modify)@@ -37,7 +36,7 @@ import Debian.Debianize.InputDebian (dataTop, dataDest, inputChangeLog) import Debian.Debianize.Monad as Monad (CabalT, liftCabal, unlessM) import Debian.Debianize.Options (compileCommandlineArgs, compileEnvironmentArgs)-import Debian.Debianize.Prelude ((%=), (+=), (~=), (~?=))+import Debian.Debianize.Prelude ((.?=)) import qualified Debian.Debianize.SourceDebDescription as S import Debian.Debianize.VersionSplits (DebBase(DebBase)) import Debian.Orphans ()@@ -55,7 +54,7 @@ import Distribution.Package (Dependency(..), PackageIdentifier(..), PackageName(PackageName)) import Distribution.PackageDescription as Cabal (allBuildInfo, author, BuildInfo(buildable, extraLibs), Executable(buildInfo, exeName), FlagName(FlagName), maintainer, PackageDescription(testSuites)) import qualified Distribution.PackageDescription as Cabal (PackageDescription(dataFiles, executables, library, package))-import Prelude hiding ((.), init, log, map, unlines, unlines, writeFile)+import Prelude hiding (init, log, map, unlines, unlines, writeFile) import System.FilePath ((<.>), (</>), makeRelative, splitFileName, takeDirectory, takeFileName) import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr(..)) import Text.PrettyPrint.HughesPJClass (Pretty(pPrint))@@ -79,7 +78,7 @@     do date <- liftIO getCurrentLocalRFC822Time        debhelperCompat <- liftIO getDebhelperCompatLevel        finalizeDebianization' date debhelperCompat-       vb <- access (A.debInfo . D.flags . verbosity)+       vb <- use (A.debInfo . D.flags . verbosity)        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@@ -93,39 +92,39 @@ 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...-       hc <- access (A.debInfo . D.flags . compilerFlavor)-       pkgDesc <- access A.packageDescription+       hc <- use (A.debInfo . D.flags . compilerFlavor)+       pkgDesc <- use A.packageDescription -       testsEnabled <- access (A.debInfo . D.enableTests)+       testsEnabled <- use (A.debInfo . D.enableTests)        let testsExist = not $ List.null $ Cabal.testSuites pkgDesc        when (testsExist && testsEnabled) $             do (A.debInfo . rulesSettings) %= (++ ["DEB_ENABLE_TESTS = yes"])-               unlessM (access (A.debInfo . D.runTests)) $ (A.debInfo . D.rulesSettings) %= (++ ["DEB_BUILD_OPTIONS += nocheck"])+               unlessM (use (A.debInfo . D.runTests)) $ (A.debInfo . D.rulesSettings) %= (++ ["DEB_BUILD_OPTIONS += nocheck"])         finalizeSourceName B.HaskellSource        checkOfficialSettings hc        addExtraLibDependencies hc-       (A.debInfo . D.watch) ~?= Just (watchAtom (pkgName $ Cabal.package $ pkgDesc))-       (A.debInfo . D.control . S.section) ~?= Just (MainSection "haskell")-       (A.debInfo . D.control . S.priority) ~?= Just Extra-       (A.debInfo . D.sourceFormat) ~?= Just Quilt3-       (A.debInfo . D.compat) ~?= debhelperCompat+       (A.debInfo . D.watch) .?= Just (watchAtom (pkgName $ Cabal.package $ pkgDesc))+       (A.debInfo . D.control . S.section) .?= Just (MainSection "haskell")+       (A.debInfo . D.control . S.priority) .?= Just Extra+       (A.debInfo . D.sourceFormat) .?= Just Quilt3+       (A.debInfo . D.compat) .?= debhelperCompat        finalizeChangelog date        finalizeControl        finalizeRules-       -- T.license ~?= Just (Cabal.license pkgDesc)+       -- T.license .?= Just (Cabal.license pkgDesc)        expandAtoms        -- Create the binary packages for the web sites, servers, backup packges, and other executables-       access (A.debInfo . D.executable) >>= List.mapM_ (cabalExecBinaryPackage . fst) . Map.toList-       access (A.debInfo . D.backups) >>= List.mapM_ (cabalExecBinaryPackage . fst) . Map.toList-       access (A.debInfo . D.serverInfo) >>= List.mapM_ (cabalExecBinaryPackage . fst) . Map.toList-       access (A.debInfo . D.website) >>= List.mapM_ (cabalExecBinaryPackage . fst) . Map.toList+       use (A.debInfo . D.executable) >>= List.mapM_ (cabalExecBinaryPackage . fst) . Map.toList+       use (A.debInfo . D.backups) >>= List.mapM_ (cabalExecBinaryPackage . fst) . Map.toList+       use (A.debInfo . D.serverInfo) >>= List.mapM_ (cabalExecBinaryPackage . fst) . Map.toList+       use (A.debInfo . D.website) >>= 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 (A.debInfo . D.control . S.binaryPackages) >>= return . List.map (getL B.package)-       allowSelfDeps <- access (A.debInfo . D.allowDebianSelfBuildDeps)+       debs <- use (A.debInfo . D.control . S.binaryPackages) >>= return . List.map (view B.package)+       allowSelfDeps <- use (A.debInfo . D.allowDebianSelfBuildDeps)        putBuildDeps (if allowSelfDeps then id else filterRelations debs) pkgDesc        -- Sketchy - I think more things that need expanded could be generated by the code        -- executed since the last expandAtoms.  Anyway, should be idempotent.@@ -138,13 +137,13 @@ -- have already been set. {- finalizeDescriptions :: (Monad m, Functor m) => CabalT m ()-finalizeDescriptions = access T.binaryPackages >>= List.mapM_ finalizeDescription+finalizeDescriptions = use T.binaryPackages >>= List.mapM_ finalizeDescription  finalizeDescription :: (Monad m, Functor m) => B.BinaryDebDescription -> CabalT m () finalizeDescription bdd =-    do let b = getL B.package bdd+    do let b = view B.package bdd        cabDesc <- describe-       T.debianDescription ~?= Just cabDesc+       T.debianDescription .?= Just cabDesc -}  -- | Construct the final Debian version number.@@ -158,12 +157,12 @@ -- The --deb-version argument overrides everything. debianVersion :: (Monad m, Functor m) => CabalT m V.DebianVersion debianVersion =-    do cabalName <- (pkgName . Cabal.package) <$> access A.packageDescription-       (cabalVersion :: V.DebianVersion) <- (V.parseDebianVersion . ppShow . pkgVersion . Cabal.package) <$> access A.packageDescription+    do cabalName <- (pkgName . Cabal.package) <$> use A.packageDescription+       (cabalVersion :: V.DebianVersion) <- (V.parseDebianVersion . ppShow . pkgVersion . Cabal.package) <$> use A.packageDescription        cabalEpoch <- debianEpoch cabalName-       fmt <- access (A.debInfo . D.sourceFormat)+       fmt <- use (A.debInfo . D.sourceFormat)        cabalRevision <--           do x <- access (A.debInfo . D.revision) -- from the --revision option+           do x <- use (A.debInfo . D.revision) -- from the --revision option               let y = case x of                         Nothing -> Nothing                         Just "" -> Nothing@@ -173,8 +172,8 @@               return $ case fmt of                          Just Native3 -> y                          _ -> maybe (Just "1") (Just . max "1") y-       versionArg <- access (A.debInfo . D.debVersion) -- from the --deb-version option-       (debianVersion :: Maybe V.DebianVersion) <- access (A.debInfo . D.changelog) >>= return . maybe Nothing changelogVersion+       versionArg <- use (A.debInfo . D.debVersion) -- from the --deb-version option+       (debianVersion :: Maybe V.DebianVersion) <- use (A.debInfo . D.changelog) >>= return . maybe Nothing changelogVersion         case () of          _ | maybe False (\ v -> v < V.buildDebianVersion cabalEpoch (ppShow cabalVersion) Nothing) versionArg ->@@ -200,7 +199,7 @@ -- | 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 -> CabalT m (Maybe Int)-debianEpoch name = get >>= return . Map.lookup name . getL A.epochMap+debianEpoch name = get >>= return . Map.lookup name . view A.epochMap  -- | Compute and return the debian source package name, based on the -- sourcePackageName if it was specified, and constructed from the@@ -208,7 +207,7 @@ finalizeSourceName :: (Monad m, Functor m) => B.PackageType -> CabalT m () finalizeSourceName typ =     do DebBase debName <- debianNameBase-       (A.debInfo . D.sourcePackageName) ~?= Just (SrcPkgName (case typ of+       (A.debInfo . D.sourcePackageName) .?= Just (SrcPkgName (case typ of                                                    B.HaskellSource -> "haskell-" ++ debName                                                    B.Source -> debName                                                    _ -> error $ "finalizeSourceName: " ++ show typ))@@ -226,17 +225,17 @@ -- <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Uploaders> finalizeMaintainer :: MonadIO m => CabalT m () finalizeMaintainer = do-  o <- access (A.debInfo . D.official)+  o <- use (A.debInfo . D.official)   currentUser <- liftIO getCurrentDebianUser-  pkgDesc <- access A.packageDescription-  maintainerOption <- access (A.debInfo . D.maintainerOption)-  uploadersOption <- access (A.debInfo . D.uploadersOption)+  pkgDesc <- use A.packageDescription+  maintainerOption <- use (A.debInfo . D.maintainerOption)+  uploadersOption <- use (A.debInfo . D.uploadersOption)   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 <- access (A.debInfo . D.changelog)+      do log <- use (A.debInfo . D.changelog)          case log of            Just (ChangeLog (entry : _)) ->                case (parseMaintainer (logWho entry)) of@@ -245,30 +244,30 @@            _ -> return Nothing   case o of     True -> do-      (A.debInfo . D.control . S.maintainer) ~= Just haskellMaintainer+      (A.debInfo . D.control . S.maintainer) .= Just haskellMaintainer       (A.debInfo . D.control . S.uploaders) %= whenEmpty (maybe [] (: []) currentUser)     False -> do-      (A.debInfo . D.control . S.maintainer) ~?= maintainerOption-      (A.debInfo . D.control . S.maintainer) ~?= (either (const Nothing) Just $ parseMaintainer cabalMaintainerString)-      (A.debInfo . D.control . S.maintainer) ~?= (either (const Nothing) Just $ parseMaintainer cabalMaintainerString')-      (A.debInfo . D.control . S.maintainer) ~?= (either (const Nothing) Just $ parseMaintainer cabalMaintainerString'')+      (A.debInfo . D.control . S.maintainer) .?= maintainerOption+      (A.debInfo . D.control . S.maintainer) .?= (either (const Nothing) Just $ parseMaintainer cabalMaintainerString)+      (A.debInfo . D.control . S.maintainer) .?= (either (const Nothing) Just $ parseMaintainer cabalMaintainerString')+      (A.debInfo . D.control . S.maintainer) .?= (either (const Nothing) Just $ parseMaintainer cabalMaintainerString'')       -- Sometimes the maintainer is just an email, if it matches the author's email we can use it-      (A.debInfo . D.control . S.maintainer) ~?= (case parseMaintainer cabalAuthorString of+      (A.debInfo . D.control . S.maintainer) .?= (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-      (A.debInfo . D.control . S.maintainer) ~?= (case parseMaintainer cabalAuthorString of+      (A.debInfo . D.control . S.maintainer) .?= (case parseMaintainer cabalAuthorString of                                         Right (NameAddr {nameAddr_name = Just name}) -> either (const Nothing) Just (parseMaintainer (name ++ " <" ++ cabalMaintainerString ++ ">"))                                         _ -> Nothing)-      (A.debInfo . D.control . S.maintainer) ~?= currentUser-      (A.debInfo . D.control . S.maintainer) ~?= changelogSignature-      x <- access (A.debInfo . D.control . S.maintainer)+      (A.debInfo . D.control . S.maintainer) .?= currentUser+      (A.debInfo . D.control . S.maintainer) .?= changelogSignature+      x <- use (A.debInfo . D.control . S.maintainer)       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 ())-      (A.debInfo . D.control . S.maintainer) ~?= (either (const Nothing) Just $ parseMaintainer "nobody <nobody@nowhere>")+      (A.debInfo . D.control . S.maintainer) .?= (either (const Nothing) Just $ parseMaintainer "nobody <nobody@nowhere>")       (A.debInfo . D.control . S.uploaders) %= whenEmpty uploadersOption  -- | If l is the empty list return d, otherwise return l.@@ -279,10 +278,10 @@ finalizeControl :: (MonadIO m, Functor m) => CabalT m () finalizeControl =     do finalizeMaintainer-       Just src <- access (A.debInfo . D.sourcePackageName)-       (A.debInfo . D.control . S.source) ~= Just src+       Just src <- use (A.debInfo . D.sourcePackageName)+       (A.debInfo . D.control . S.source) .= Just src        desc' <- describe-       (A.debInfo . D.control . S.xDescription) ~?= Just desc'+       (A.debInfo . D.control . S.xDescription) .?= 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@@ -293,10 +292,10 @@ finalizeChangelog date =     do finalizeMaintainer        ver <- debianVersion-       src <- access (A.debInfo . D.sourcePackageName)-       Just debianMaintainer <- access (A.debInfo . D.control . S.maintainer)-       -- pkgDesc <- access T.packageDescription >>= return . maybe Nothing (either Nothing Just . parseMaintainer . Cabal.maintainer)-       cmts <- access (A.debInfo . D.comments)+       src <- use (A.debInfo . D.sourcePackageName)+       Just debianMaintainer <- use (A.debInfo . D.control . S.maintainer)+       -- pkgDesc <- use T.packageDescription >>= return . maybe Nothing (either Nothing Just . parseMaintainer . Cabal.maintainer)+       cmts <- use (A.debInfo . D.comments)        (A.debInfo . D.changelog) %= fmap (dropFutureEntries ver)        let msg = "Initial release (Closes: #nnnn)"        (A.debInfo . D.changelog) %= fixLog src ver cmts debianMaintainer msg@@ -328,10 +327,10 @@ -- devel package (if there is one.) addExtraLibDependencies :: (Monad m, Functor m) => CompilerFlavor -> CabalT m () addExtraLibDependencies hc =-    do pkgDesc <- access A.packageDescription+    do pkgDesc <- use A.packageDescription        devName <- debianName B.Development hc-       libMap <- access (A.debInfo . D.extraLibMap)-       binNames <- List.map (getL B.package) <$> access (A.debInfo . D.control . S.binaryPackages)+       libMap <- use (A.debInfo . D.extraLibMap)+       binNames <- List.map (view B.package) <$> use (A.debInfo . D.control . S.binaryPackages)        when (any (== devName) binNames) ((A.debInfo . D.binaryDebDescription devName . B.relations . B.depends) %= \ deps -> deps ++ g pkgDesc libMap)     where       g :: PackageDescription -> Map String Relations -> Relations@@ -342,20 +341,20 @@ -- | Applies a few settings to official packages (unless already set) checkOfficialSettings :: (Monad m, Functor m) => CompilerFlavor -> CabalT m () checkOfficialSettings flavor =-    do o <- access (A.debInfo . D.official)+    do o <- use (A.debInfo . D.official)        when o $ case flavor of                   GHC -> officialSettings                   _ -> error $ "There is no official packaging for " ++ show flavor  officialSettings :: (Monad m, Functor m) => CabalT m () officialSettings =-    do pkgDesc <- access A.packageDescription+    do pkgDesc <- use A.packageDescription        let PackageName cabal = pkgName (Cabal.package pkgDesc) -       (A.debInfo . D.control . S.standardsVersion) ~?= Just (parseStandardsVersion "3.9.6")-       (A.debInfo . D.control . S.homepage) ~?= Just ("http://hackage.haskell.org/package/" <> pack cabal)-       (A.debInfo . D.omitProfVersionDeps) ~= True-       SrcPkgName src <- access (A.debInfo . D.sourcePackageName) >>= maybe (error "officialSettings: no sourcePackageName") return+       (A.debInfo . D.control . S.standardsVersion) .?= Just (parseStandardsVersion "3.9.6")+       (A.debInfo . D.control . S.homepage) .?= Just ("http://hackage.haskell.org/package/" <> pack cabal)+       (A.debInfo . D.omitProfVersionDeps) .= True+       SrcPkgName src <- use (A.debInfo . D.sourcePackageName) >>= maybe (error "officialSettings: no sourcePackageName") return         (A.debInfo . D.control . S.vcsFields) %= Set.union (Set.fromList           [ S.VCSBrowser $ "http://darcs.debian.org/cgi-bin/darcsweb.cgi?r=pkg-haskell/" <> pack src@@ -366,8 +365,8 @@ putBuildDeps finalizeRelations pkgDesc =     do deps <- debianBuildDeps pkgDesc >>= return . finalizeRelations        depsIndep <- debianBuildDepsIndep pkgDesc >>= return . finalizeRelations-       (A.debInfo . D.control . S.buildDepends) ~= deps-       (A.debInfo . D.control . S.buildDependsIndep) ~= depsIndep+       (A.debInfo . D.control . S.buildDepends) .= deps+       (A.debInfo . D.control . S.buildDependsIndep) .= depsIndep  -- | Filter out any relations that mention any of the bad package names. filterRelations :: [BinPkgName] -> Relations -> Relations@@ -379,35 +378,35 @@  cabalExecBinaryPackage :: Monad m => BinPkgName -> CabalT m () cabalExecBinaryPackage b =-    do (A.debInfo . D.binaryDebDescription b . B.packageType) ~?= Just B.Exec-       (A.debInfo . D.binaryDebDescription b . B.architecture) ~?= Just Any-       (A.debInfo . D.binaryDebDescription b . B.binarySection) ~?= Just (MainSection "misc")-       (A.debInfo . D.binaryDebDescription b . B.description) ~?= Just desc -- yeah, this same line is all over the place.+    do (A.debInfo . D.binaryDebDescription b . B.packageType) .?= Just B.Exec+       (A.debInfo . D.binaryDebDescription b . B.architecture) .?= Just Any+       (A.debInfo . D.binaryDebDescription b . B.binarySection) .?= Just (MainSection "misc")+       (A.debInfo . D.binaryDebDescription b . B.description) .?= Just desc -- yeah, this same line is all over the place.        binaryPackageRelations b B.Exec     where  binaryPackageRelations :: Monad m => BinPkgName -> B.PackageType -> CabalT m () binaryPackageRelations b typ =-    do edds <- access (A.debInfo . D.extraDevDeps)+    do edds <- use (A.debInfo . D.extraDevDeps)        (A.debInfo . D.binaryDebDescription b . B.relations . B.depends) %= \ rels ->           [anyrel "${haskell:Depends}", anyrel "${misc:Depends}"] ++           [anyrel "${shlibs:Depends}" | typ `notElem` [B.Profiling, B.Documentation] ] ++           edds ++ rels        (A.debInfo . D.binaryDebDescription b . B.relations . B.recommends) %= \ rels -> [anyrel "${haskell:Recommends}"] ++ rels        (A.debInfo . D.binaryDebDescription b . B.relations . B.suggests) %= \ rels -> [anyrel "${haskell:Suggests}"] ++ rels-       (A.debInfo . D.binaryDebDescription b . B.relations . B.preDepends) ~= []-       (A.debInfo . D.binaryDebDescription b . B.relations . B.breaks) ~= []+       (A.debInfo . D.binaryDebDescription b . B.relations . B.preDepends) .= []+       (A.debInfo . D.binaryDebDescription b . B.relations . B.breaks) .= []        (A.debInfo . D.binaryDebDescription b . B.relations . B.conflicts) %= \ rels -> [anyrel "${haskell:Conflicts}"] ++ rels        (A.debInfo . D.binaryDebDescription b . B.relations . B.provides) %= \ rels -> (if typ /= B.Documentation then [anyrel "${haskell:Provides}"] else []) ++ rels        -- T.replaces b %= \ rels -> [anyrel "${haskell:Replaces}"] ++ rels-       (A.debInfo . D.binaryDebDescription b . B.relations . B.builtUsing) ~= []+       (A.debInfo . D.binaryDebDescription b . B.relations . B.builtUsing) .= []  -- | Add the library paragraphs for a particular compiler flavor. librarySpecs :: (Monad m, Functor m) => PackageDescription -> CompilerFlavor -> CabalT m () librarySpecs pkgDesc hc =     do let dev = isJust (Cabal.library pkgDesc)-       doc <- get >>= return . not . getL (A.debInfo . D.noDocumentationLibrary)-       prof <- get >>= return . not . getL (A.debInfo . D.noProfilingLibrary)+       doc <- get >>= return . not . view (A.debInfo . D.noDocumentationLibrary)+       prof <- get >>= return . not . view (A.debInfo . D.noProfilingLibrary)        when dev (librarySpec Any B.Development hc)        when (dev && prof && hc == GHC) (librarySpec Any B.Profiling hc)        when (dev && doc) (docSpecsParagraph hc)@@ -416,20 +415,20 @@ docSpecsParagraph hc =     do b <- debianName B.Documentation hc        binaryPackageRelations b B.Documentation-       (A.debInfo . D.binaryDebDescription b . B.packageType) ~?= Just B.Documentation-       (A.debInfo . D.binaryDebDescription b . B.packageType) ~?= Just B.Documentation-       (A.debInfo . D.binaryDebDescription b . B.architecture) ~= Just All-       (A.debInfo . D.binaryDebDescription b . B.binarySection) ~?= Just (MainSection "doc")-       (A.debInfo . D.binaryDebDescription b . B.description) ~?= Just desc+       (A.debInfo . D.binaryDebDescription b . B.packageType) .?= Just B.Documentation+       (A.debInfo . D.binaryDebDescription b . B.packageType) .?= Just B.Documentation+       (A.debInfo . D.binaryDebDescription b . B.architecture) .= Just All+       (A.debInfo . D.binaryDebDescription b . B.binarySection) .?= Just (MainSection "doc")+       (A.debInfo . D.binaryDebDescription b . B.description) .?= Just desc  librarySpec :: (Monad m, Functor m) => PackageArchitectures -> B.PackageType -> CompilerFlavor -> CabalT m () librarySpec arch typ hc =     do b <- debianName typ hc        binaryPackageRelations b typ-       (A.debInfo . D.binaryDebDescription b . B.packageType) ~?= Just typ-       (A.debInfo . D.binaryDebDescription b . B.packageType) ~?= Just typ-       (A.debInfo . D.binaryDebDescription b . B.architecture) ~?= Just arch-       (A.debInfo . D.binaryDebDescription b . B.description) ~?= Just desc+       (A.debInfo . D.binaryDebDescription b . B.packageType) .?= Just typ+       (A.debInfo . D.binaryDebDescription b . B.packageType) .?= Just typ+       (A.debInfo . D.binaryDebDescription b . B.architecture) .?= Just arch+       (A.debInfo . D.binaryDebDescription b . B.description) .?= Just desc  -- | This is the standard value for the Description field of a binary -- package control file stanza.@@ -452,18 +451,18 @@        -- Files that are already assigned to any binary deb        installedDataMap <- Set.fold (\ x r ->                                          case x of-                                           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 (A.debInfo . D.atomSet) :: CabalT m (Map BinPkgName (Set FilePath))+                                           D.Install b src _ -> Map.insertWith Set.union b (singleton src) r+                                           D.InstallTo b src _ -> Map.insertWith Set.union b (singleton src) r+                                           D.InstallData b src  _ -> Map.insertWith Set.union b (singleton src) r+                                           _ -> r) mempty <$> use (A.debInfo . D.atomSet) :: CabalT m (Map BinPkgName (Set FilePath))        installedExecMap <- Set.fold (\ x r ->                                          case x of                                            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 (A.debInfo . D.atomSet) :: CabalT m (Map BinPkgName (Set String))+                                           _ -> r) mempty <$> use (A.debInfo . D.atomSet) :: CabalT m (Map BinPkgName (Set String))         -- The names of cabal executables that go into eponymous debs-       insExecPkg <- access (A.debInfo . D.executable) >>= return . Set.map ename . Set.fromList . elems+       insExecPkg <- use (A.debInfo . D.executable) >>= 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)@@ -474,9 +473,9 @@        let availableData = Set.union installedData dataFilePaths            availableExec = Set.union installedExec execFilePaths -       access (A.debInfo . D.utilsPackageNameBase) >>= \ name ->+       use (A.debInfo . D.utilsPackageNameBase) >>= \ name ->            case name of-             Nothing -> debianName B.Utilities hc >>= \ (BinPkgName name') -> (A.debInfo . D.utilsPackageNameBase) ~= Just name'+             Nothing -> debianName B.Utilities hc >>= \ (BinPkgName name') -> (A.debInfo . D.utilsPackageNameBase) .= Just name'              _ -> return ()        b <- debianName B.Utilities hc @@ -492,11 +491,11 @@            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-         (A.debInfo . D.binaryDebDescription b . B.description) ~?= Just desc+         (A.debInfo . D.binaryDebDescription b . B.description) .?= Just desc          -- This is really for all binary debs except the libraries - I'm not sure why-         (A.debInfo . D.rulesFragments)+= (pack ("build" </> ppShow b ++ ":: build-ghc-stamp\n"))-         (A.debInfo . D.binaryDebDescription b . B.architecture) ~?= Just (if Set.null utilsExec then All else Any)-         (A.debInfo . D.binaryDebDescription b . B.binarySection) ~?= Just (MainSection "misc")+         (A.debInfo . D.rulesFragments) %= Set.insert (pack ("build" </> ppShow b ++ ":: build-ghc-stamp\n"))+         (A.debInfo . D.binaryDebDescription b . B.architecture) .?= Just (if Set.null utilsExec then All else Any)+         (A.debInfo . D.binaryDebDescription b . B.binarySection) .?= Just (MainSection "misc")          binaryPackageRelations b B.Utilities        -- Add the unassigned files to the utils packages        Set.mapM_ (\ (foo, bar) -> (A.debInfo . D.atomSet) %= (Set.insert $ D.InstallData b foo bar)) utilsDataMissing@@ -509,13 +508,14 @@  expandAtoms :: MonadIO m => CabalT m () expandAtoms =-    do hc <- access (A.debInfo . D.flags . compilerFlavor)+    do hc <- use (A.debInfo . D.flags . compilerFlavor)        case hc of          GHC -> (A.debInfo . D.flags . cabalFlagAssignments) %= (Set.union (Set.fromList (flagList "--ghc"))) #if MIN_VERSION_Cabal(1,22,0)          GHCJS -> (A.debInfo . D.flags . cabalFlagAssignments) %= (Set.union (Set.fromList (flagList "--ghcjs"))) #endif-       builddir <- access (A.debInfo . D.buildDir) >>= return . fromMaybe (case hc of+         x -> error $ "Sorry, compiler not supported: " ++ show x+       builddir <- use (A.debInfo . D.buildDir) >>= return . fromMaybe (case hc of                                                                GHC -> "dist-ghc/build" #if MIN_VERSION_Cabal(1,22,0)                                                                GHCJS -> "dist-ghcjs/build"@@ -535,7 +535,7 @@     where       expandApacheSites :: Monad m => CabalT m ()       expandApacheSites =-          do mp <- get >>= return . getL (A.debInfo . D.apacheSite)+          do mp <- get >>= return . view (A.debInfo . D.apacheSite)              List.mapM_ expandApacheSite (Map.toList mp)           where             expandApacheSite (b, (dom, log, text)) =@@ -546,8 +546,8 @@       -- Turn A.InstallCabalExec into A.Install       expandInstallCabalExecs :: Monad m => FilePath -> CabalT m ()       expandInstallCabalExecs builddir = do-        hc <- access (A.debInfo . D.flags . compilerFlavor)-        access (A.debInfo . D.atomSet) >>= Set.mapM_ (doAtom hc)+        hc <- use (A.debInfo . D.flags . compilerFlavor)+        use (A.debInfo . D.atomSet) >>= Set.mapM_ (doAtom hc)           where             doAtom :: Monad m => CompilerFlavor -> D.Atom -> CabalT m ()             doAtom GHC (D.InstallCabalExec b name dest) = (A.debInfo . D.atomSet) %= (Set.insert $ D.Install b (builddir </> name </> name) dest)@@ -555,7 +555,7 @@             -- A GHCJS executable is a directory with files, copy them             -- all into place.             doAtom GHCJS (D.InstallCabalExec b name dest) =-                (A.debInfo . D.rulesFragments) +=+                (A.debInfo . D.rulesFragments) %= Set.insert                      (Text.unlines                         [ pack ("binary-fixup" </> ppShow b) <> "::"                         , pack ("\t(cd " <> builddir </> name <> " && find " <> name <.> "jsexe" <> " -type f) |\\\n" <>@@ -566,12 +566,12 @@       -- Turn A.InstallCabalExecTo into a make rule       expandInstallCabalExecTo :: Monad m => FilePath -> CabalT m ()       expandInstallCabalExecTo builddir = do-        hc <- access (A.debInfo . D.flags . compilerFlavor)-        access (A.debInfo . D.atomSet) >>= Set.mapM_ (doAtom hc)+        hc <- use (A.debInfo . D.flags . compilerFlavor)+        use (A.debInfo . D.atomSet) >>= Set.mapM_ (doAtom hc)           where             doAtom :: Monad m => CompilerFlavor -> D.Atom -> CabalT m ()             doAtom GHC (D.InstallCabalExecTo b name dest) =-                (A.debInfo . D.rulesFragments) +=+                (A.debInfo . D.rulesFragments) %= Set.insert                                      (Text.unlines                                        [ pack ("binary-fixup" </> ppShow b) <> "::"                                        , "\tinstall -Dps " <> pack (builddir </> name </> name) <> " "@@ -582,70 +582,70 @@       -- Turn A.InstallData into either an Install or an InstallTo       expandInstallData :: Monad m => FilePath -> CabalT m ()       expandInstallData dDest =-          access (A.debInfo . D.atomSet) >>= List.mapM_ doAtom . Set.toList+          use (A.debInfo . D.atomSet) >>= List.mapM_ doAtom . Set.toList           where             doAtom :: Monad m => D.Atom -> CabalT m ()-            doAtom (D.InstallData b from dest) =-                if takeFileName from == takeFileName dest-                then (A.debInfo . D.atomSet) %= (Set.insert $ D.Install b from (dDest </> makeRelative "/" (takeDirectory dest)))-                else (A.debInfo . D.atomSet) %= (Set.insert $ D.InstallTo b from (dDest </> makeRelative "/" dest))+            doAtom (D.InstallData b src dest) =+                if takeFileName src == takeFileName dest+                then (A.debInfo . D.atomSet) %= (Set.insert $ D.Install b src (dDest </> makeRelative "/" (takeDirectory dest)))+                else (A.debInfo . D.atomSet) %= (Set.insert $ D.InstallTo b src (dDest </> makeRelative "/" dest))             doAtom _ = return ()        -- Turn A.InstallTo into a make rule       expandInstallTo :: Monad m => CabalT m ()       expandInstallTo =-          access (A.debInfo . D.atomSet) >>= List.mapM_ doAtom . Set.toList+          use (A.debInfo . D.atomSet) >>= List.mapM_ doAtom . Set.toList           where             doAtom :: Monad m => D.Atom -> CabalT m ()-            doAtom (D.InstallTo b from dest) =-                (A.debInfo . D.rulesFragments) +=+            doAtom (D.InstallTo b src dest) =+                (A.debInfo . D.rulesFragments) %= Set.insert                                     (Text.unlines [ pack ("binary-fixup" </> ppShow b) <> "::"-                                                  , "\tinstall -Dp " <> pack from <> " " <> pack ("debian" </> ppShow b </> makeRelative "/" dest) ])+                                                  , "\tinstall -Dp " <> pack src <> " " <> pack ("debian" </> ppShow b </> makeRelative "/" dest) ])             doAtom _ = return ()        -- Turn A.File into an intermediateFile and an A.Install       expandFile :: Monad m => CabalT m ()       expandFile =-          access (A.debInfo . D.atomSet) >>= List.mapM_ doAtom . Set.toList+          use (A.debInfo . D.atomSet) >>= List.mapM_ doAtom . Set.toList           where             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'-                   (A.debInfo . D.intermediateFiles) += (tmpPath, text)+                   (A.debInfo . D.intermediateFiles) %= Set.insert (tmpPath, text)                    (A.debInfo . D.atomSet) %= (Set.insert $ D.Install b tmpPath destDir')             doAtom _ = return ()        expandWebsite :: Monad m => CabalT m ()       expandWebsite =-          do mp <- get >>= return . getL (A.debInfo . D.website)+          do mp <- get >>= return . view (A.debInfo . D.website)              List.mapM_ (\ (b, site) -> modify (siteAtoms b site)) (Map.toList mp)        expandServer :: Monad m => CabalT m ()       expandServer =-          do mp <- get >>= return . getL (A.debInfo . D.serverInfo)+          do mp <- get >>= return . view (A.debInfo . D.serverInfo)              List.mapM_ (\ (b, x) -> modify (serverAtoms b x False)) (Map.toList mp)        expandBackups :: Monad m => CabalT m ()       expandBackups =-          do mp <- get >>= return . getL (A.debInfo . D.backups)+          do mp <- get >>= return . view (A.debInfo . D.backups)              List.mapM_ (\ (b, name) -> modify (backupAtoms b name)) (Map.toList mp)        expandExecutable :: Monad m => CabalT m ()       expandExecutable =-          do mp <- get >>= return . getL (A.debInfo . D.executable)+          do mp <- get >>= return . view (A.debInfo . D.executable)              List.mapM_ (\ (b, f) -> modify (execAtoms b f)) (Map.toList mp)  -- | Add the normal default values to the rules files. finalizeRules :: (Monad m, Functor m) => CabalT m () finalizeRules =     do DebBase b <- debianNameBase-       compiler <- access (A.debInfo . D.flags . compilerFlavor)-       (A.debInfo . D.rulesHead) ~?= Just "#!/usr/bin/make -f"+       compiler <- use (A.debInfo . D.flags . compilerFlavor)+       (A.debInfo . D.rulesHead) .?= Just "#!/usr/bin/make -f"        (A.debInfo . D.rulesSettings) %= (++ ["DEB_CABAL_PACKAGE = " <> pack b])        (A.debInfo . D.rulesSettings) %= (++ (["DEB_DEFAULT_COMPILER = " <> pack (List.map toLower (show compiler))]))-       flags <- (flagString . Set.toList) <$> access (A.debInfo . D.flags . cabalFlagAssignments)+       flags <- (flagString . Set.toList) <$> use (A.debInfo . D.flags . cabalFlagAssignments)        unless (List.null flags) ((A.debInfo . D.rulesSettings) %= (++ ["DEB_SETUP_GHC6_CONFIGURE_ARGS = " <> pack flags]))        (A.debInfo . D.rulesIncludes) %= (++ ["include /usr/share/cdbs/1/rules/debhelper.mk",                                              "include /usr/share/cdbs/1/class/hlibrary.mk"])
src/Debian/Debianize/Goodies.hs view
@@ -18,19 +18,17 @@     , execAtoms     ) where -import OldLens (access, modL)--import Control.Category ((.))+import Control.Lens import Data.Char (isSpace) import Data.List as List (dropWhileEnd, intercalate, intersperse, map)-import Data.Map as Map (insertWith)+import Data.Map as Map (insert, insertWith) import Data.Maybe (fromMaybe)-import Data.Monoid ((<>))+import Data.Monoid ((<>), mappend) 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 Debian.Debianize.Prelude (stripWith) import qualified Debian.Debianize.CabalInfo as A import qualified Debian.Debianize.BinaryDebDescription as B import Debian.Orphans ()@@ -39,7 +37,7 @@ import Debian.Relation (BinPkgName(BinPkgName), Relation(Rel)) import Distribution.Package (PackageName(PackageName)) import Distribution.PackageDescription as Cabal (PackageDescription(package, synopsis, description))-import Prelude hiding ((.), init, log, map, unlines, writeFile)+import Prelude hiding (init, log, map, unlines, writeFile) import System.FilePath ((</>))  showCommand :: String -> [String] -> String@@ -60,7 +58,7 @@ tightDependencyFixup :: Monad m => [(BinPkgName, BinPkgName)] -> BinPkgName -> DebianT m () tightDependencyFixup [] _ = return () tightDependencyFixup pairs p =-    D.rulesFragments +=+    D.rulesFragments %= Set.insert           (Text.unlines $                ([ "binary-fixup/" <> name <> "::"                 , "\techo -n 'haskell:Depends=' >> debian/" <> name <> ".substvars" ] ++@@ -77,26 +75,26 @@  -- | Add a debian binary package to the debianization containing a cabal executable file. doExecutable :: Monad m => BinPkgName -> D.InstallFile -> CabalT m ()-doExecutable p f = (A.debInfo . D.executable) ++= (p, f)+doExecutable p f = (A.debInfo . D.executable) %= Map.insert 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 -> D.Server -> CabalT m ()-doServer p s = (A.debInfo . D.serverInfo) ++= (p, s)+doServer p s = (A.debInfo . D.serverInfo) %= Map.insert 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 -> D.Site -> CabalT m ()-doWebsite p w = (A.debInfo . D.website) ++= (p, w)+doWebsite p w = (A.debInfo . D.website) %= Map.insert 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 -> CabalT m () doBackups bin s =-    do (A.debInfo . D.backups) ++= (bin, s)+    do (A.debInfo . D.backups) %= Map.insert bin s        (A.debInfo . D.binaryDebDescription bin . B.relations . B.depends) %= (++ [[Rel (BinPkgName "anacron") Nothing Nothing]])        -- depends +++= (bin, Rel (BinPkgName "anacron") Nothing Nothing)  describe :: Monad m => CabalT m Text describe =-    do p <- access A.packageDescription+    do p <- use A.packageDescription        return $           debianDescriptionBase p {- <> "\n" <>           case typ of@@ -176,8 +174,8 @@           (A.debInfo . D.atomSet) %= (Set.insert $ D.Link b ("/etc/apache2/sites-available/" ++ D.domain site) ("/etc/apache2/sites-enabled/" ++ D.domain site))           (A.debInfo . D.atomSet) %= (Set.insert $ D.File b ("/etc/apache2/sites-available" </> D.domain site) apacheConfig)           (A.debInfo . D.atomSet) %= (Set.insert $ D.InstallDir b (apacheLogDirectory b))-          (A.debInfo . D.logrotateStanza) +++=-                              (b, singleton+          (A.debInfo . D.logrotateStanza) %= Map.insertWith mappend b+                              (singleton                                    (Text.unlines $ [ pack (apacheAccessLog b) <> " {"                                                    , "  copytruncate" -- hslogger doesn't notice when the log is rotated, maybe this will help                                                    , "  weekly"@@ -185,8 +183,8 @@                                                    , "  compress"                                                    , "  missingok"                                                    , "}"]))-          (A.debInfo . D.logrotateStanza) +++=-                              (b, singleton+          (A.debInfo . D.logrotateStanza) %= Map.insertWith mappend b+                              (singleton                                    (Text.unlines $ [ pack (apacheErrorLog b) <> " {"                                                    , "  copytruncate"                                                    , "  weekly"@@ -236,8 +234,8 @@  serverAtoms :: BinPkgName -> D.Server -> Bool -> CabalInfo -> CabalInfo serverAtoms b server' isSite =-    modL (A.debInfo . D.postInst) (insertWith (\ old new -> if old /= new then error ("serverAtoms: " ++ show old ++ " -> " ++ show new) else old) b debianPostinst) .-    modL (A.debInfo . D.installInit) (Map.insertWith (\ old new -> if old /= new then error ("serverAtoms: " ++ show old ++ " -> " ++ show new) else old) b debianInit) .+    over (A.debInfo . D.postInst) (insertWith (\ old new -> if old /= new then error ("serverAtoms: " ++ show old ++ " -> " ++ show new) else old) b debianPostinst) .+    over (A.debInfo . D.installInit) (Map.insertWith (\ old new -> if old /= new then error ("serverAtoms: " ++ show old ++ " -> " ++ show new) else old) b debianInit) .     serverLogrotate' b .     execAtoms b exec     where@@ -301,13 +299,13 @@ -- in debianFiles. serverLogrotate' :: BinPkgName -> CabalInfo -> CabalInfo serverLogrotate' b =-    modL (A.debInfo . D.logrotateStanza) (insertWith Set.union b (singleton (Text.unlines $ [ pack (serverAccessLog b) <> " {"+    over (A.debInfo . D.logrotateStanza) (insertWith Set.union b (singleton (Text.unlines $ [ pack (serverAccessLog b) <> " {"                                  , "  weekly"                                  , "  rotate 5"                                  , "  compress"                                  , "  missingok"                                  , "}" ]))) .-    modL (A.debInfo . D.logrotateStanza) (insertWith Set.union b (singleton (Text.unlines $ [ pack (serverAppLog b) <> " {"+    over (A.debInfo . D.logrotateStanza) (insertWith Set.union b (singleton (Text.unlines $ [ pack (serverAppLog b) <> " {"                                  , "  weekly"                                  , "  rotate 5"                                  , "  compress"@@ -316,7 +314,7 @@  backupAtoms :: BinPkgName -> String -> CabalInfo -> CabalInfo backupAtoms b name =-    modL (A.debInfo . D.postInst) (insertWith (\ old new -> if old /= new then error $ "backupAtoms: " ++ show old ++ " -> " ++ show new else old) b+    over (A.debInfo . D.postInst) (insertWith (\ old new -> if old /= new then error $ "backupAtoms: " ++ show old ++ " -> " ++ show new else old) b                  (Text.unlines $                   [ "#!/bin/sh"                   , ""@@ -332,7 +330,7 @@  execAtoms :: BinPkgName -> D.InstallFile -> CabalInfo -> CabalInfo execAtoms b ifile r =-    modL (A.debInfo . D.rulesFragments) (Set.insert (pack ("build" </> ppShow b ++ ":: build-ghc-stamp\n"))) .+    over (A.debInfo . D.rulesFragments) (Set.insert (pack ("build" </> ppShow b ++ ":: build-ghc-stamp\n"))) .     fileAtoms b ifile $     r 
src/Debian/Debianize/InputCabal.hs view
@@ -4,13 +4,12 @@     ( inputCabalization     ) where -import OldLens (getL) -import Control.Category ((.)) import Control.Exception (bracket)+import Control.Lens import Control.Monad (when) import Control.Monad.Trans (MonadIO, liftIO)-import Data.Set as Set (Set, toList)+import Data.Set as Set (toList) import Debian.Debianize.BasicInfo (Flags, buildEnv, dependOS, verbosity, compilerFlavor, cabalFlagAssignments) import Debian.Debianize.Prelude (intToVerbosity') #if MIN_VERSION_Cabal(1,22,0)@@ -19,19 +18,15 @@ import Debian.GHC (newestAvailableCompilerId) #endif 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.Package (Package(packageId))+import Distribution.PackageDescription as Cabal (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 Prelude hiding (break, lines, log, null, readFile, sum) import System.Directory (doesFileExist, getCurrentDirectory) import System.Exit (ExitCode(..)) import System.Posix.Files (setFileCreationMask)@@ -44,17 +39,17 @@ -- use that information load the configured PackageDescription. inputCabalization :: MonadIO m => Flags -> WithProcAndSys m PackageDescription inputCabalization flags =-    do let root = dependOS $ getL buildEnv flags-       let vb = intToVerbosity' $ getL verbosity flags-           fs = getL cabalFlagAssignments flags+    do let root = dependOS $ view buildEnv flags+       let vb = intToVerbosity' $ view verbosity flags+           fs = view cabalFlagAssignments flags        --  Load a GenericPackageDescription from the current directory and        -- from that create a finalized PackageDescription for the given        -- CompilerId.        genPkgDesc <- liftIO $ defaultPackageDesc vb >>= readPackageDescription vb #if MIN_VERSION_Cabal(1,22,0)-       cinfo <- getCompilerInfo root (getL compilerFlavor flags)+       cinfo <- getCompilerInfo root (view compilerFlavor flags) #else-       let cinfo = newestAvailableCompilerId root (getL compilerFlavor flags)+       let cinfo = newestAvailableCompilerId root (view compilerFlavor flags) #endif        let finalized = finalizePackageDescription (toList fs) (const True) (Platform buildArch Cabal.buildOS) cinfo [] genPkgDesc        ePkgDesc <- either (return . Left)
src/Debian/Debianize/InputDebian.hs view
@@ -9,15 +9,15 @@     , dataTop     ) where -import OldLens (access, modL, setL) -import Control.Category ((.))+import Control.Lens import Control.Monad (filterM) import Control.Monad.State (put) import Control.Monad.Trans (liftIO, MonadIO) import Data.Char (isSpace)+import Data.Map as Map (insert, insertWith) import Data.Maybe (fromMaybe)-import Data.Monoid ((<>))+import Data.Monoid ((<>), mappend) import Data.Set as Set (fromList, insert, singleton) import Data.Text (break, lines, null, pack, strip, Text, unpack, words) import Data.Text.IO (readFile)@@ -26,11 +26,11 @@ 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 Debian.Debianize.Prelude (getDirectoryContents', read', readFileMaybe, (.?=)) 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(..))@@ -38,7 +38,7 @@ 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 Prelude hiding (break, lines, log, null, readFile, sum, words) import System.Directory (doesFileExist) import System.FilePath ((</>), dropExtension, takeExtension) import System.IO.Error (catchIOError, tryIOError)@@ -48,11 +48,11 @@ inputDebianization :: MonadIO m => DebianT m () inputDebianization =     do -- Erase any the existing information-       fs <- access T.flags+       fs <- use T.flags        put $ T.makeDebInfo fs        (ctl, _) <- inputSourceDebDescription        inputCabalInfoFromDirectory-       control ~= ctl+       control .= ctl  -- | Try to input a file and if successful add it to the -- debianization's list of "intermediate" files, files which will@@ -61,7 +61,7 @@ inputDebianizationFile :: MonadIO m => FilePath -> DebianT m () inputDebianizationFile path =     do inputCabalInfoFromDirectory-       liftIO (readFileMaybe path) >>= maybe (return ()) (\ text -> intermediateFiles += (path, text))+       liftIO (readFileMaybe path) >>= maybe (return ()) (\ text -> intermediateFiles %= Set.insert (path, text))  inputSourceDebDescription :: MonadIO m => DebianT m (S.SourceDebDescription, [Field]) inputSourceDebDescription =@@ -76,7 +76,7 @@     foldr readField (src, []) fields'     where       fields' = map stripField fields-      src = setL S.binaryPackages bins (S.newSourceDebDescription' findSource findMaint)+      src = set 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'@@ -88,29 +88,29 @@       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)+      readField (Field ("Standards-Version", value)) (desc, unrecognized) = (set S.standardsVersion (Just (parseStandardsVersion value)) desc, unrecognized)+      readField (Field ("Priority", value)) (desc, unrecognized) = (set S.priority (Just (readPriority value)) desc, unrecognized)+      readField (Field ("Section", value)) (desc, unrecognized) = (set 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 ("Homepage", value)) (desc, unrecognized) = (set S.homepage (Just (strip (pack value))) desc, unrecognized)+      readField (Field ("Uploaders", value)) (desc, unrecognized) = (set S.uploaders (either (const []) id (parseUploaders value)) desc, unrecognized)+      readField (Field ("DM-Upload-Allowed", value)) (desc, unrecognized) = (set S.dmUploadAllowed (yes value) desc, unrecognized)+      readField (Field ("Build-Depends", value)) (desc, unrecognized) = (set S.buildDepends (rels value) desc, unrecognized)+      readField (Field ("Build-Conflicts", value)) (desc, unrecognized) = (set S.buildConflicts (rels value) desc, unrecognized)+      readField (Field ("Build-Depends-Indep", value)) (desc, unrecognized) = (set S.buildDependsIndep (rels value) desc, unrecognized)+      readField (Field ("Build-Conflicts-Indep", value)) (desc, unrecognized) = (set S.buildConflictsIndep (rels value) desc, unrecognized)+      readField (Field ("Vcs-Browser", s)) (desc, unrecognized) = (over S.vcsFields (\ vcsFields -> Set.insert (S.VCSBrowser (pack s)) vcsFields) desc, unrecognized)+      readField (Field ("Vcs-Arch", s)) (desc, unrecognized) = (over S.vcsFields (\ vcsFields -> Set.insert (S.VCSArch (pack s)) vcsFields) desc, unrecognized)+      readField (Field ("Vcs-Bzr", s)) (desc, unrecognized) = (over S.vcsFields (\ vcsFields -> Set.insert (S.VCSBzr (pack s)) vcsFields) desc, unrecognized)+      readField (Field ("Vcs-Cvs", s)) (desc, unrecognized) = (over S.vcsFields (\ vcsFields -> Set.insert (S.VCSCvs (pack s)) vcsFields) desc, unrecognized)+      readField (Field ("Vcs-Darcs", s)) (desc, unrecognized) = (over S.vcsFields (\ vcsFields -> Set.insert (S.VCSDarcs (pack s)) vcsFields) desc, unrecognized)+      readField (Field ("Vcs-Git", s)) (desc, unrecognized) = (over S.vcsFields (\ vcsFields -> Set.insert (S.VCSGit (pack s)) vcsFields) desc, unrecognized)+      readField (Field ("Vcs-Hg", s)) (desc, unrecognized) = (over S.vcsFields (\ vcsFields -> Set.insert (S.VCSHg (pack s)) vcsFields) desc, unrecognized)+      readField (Field ("Vcs-Mtn", s)) (desc, unrecognized) = (over S.vcsFields (\ vcsFields -> Set.insert (S.VCSMtn (pack s)) vcsFields) desc, unrecognized)+      readField (Field ("Vcs-Svn", s)) (desc, unrecognized) = (over S.vcsFields (\ vcsFields -> Set.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)+            (xs, '-' : more) -> (over S.xFields (\ xFields -> Set.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) @@ -119,7 +119,7 @@     foldr readField (bin, []) fields'     where       fields' = map stripField fields-      bin = setL B.architecture (Just arch) (newBinaryDebDescription b)+      bin = set B.architecture (Just arch) (newBinaryDebDescription b)       b :: BinPkgName       b = findMap "Package" BinPkgName fields'       arch = findMap "Architecture" parsePackageArchitectures fields'@@ -131,21 +131,21 @@ -}        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.relations . B.depends) (rels x) desc, unrecognized)-      readField (Field ("Recommends", x)) (desc, unrecognized) = (setL (B.relations . B.recommends) (rels x) desc, unrecognized)-      readField (Field ("Suggests", x)) (desc, unrecognized) = (setL (B.relations . B.suggests) (rels x) desc, unrecognized)-      readField (Field ("Pre-Depends", x)) (desc, unrecognized) = (setL (B.relations . B.preDepends) (rels x) desc, unrecognized)-      readField (Field ("Breaks", x)) (desc, unrecognized) = (setL (B.relations . B.breaks) (rels x) desc, unrecognized)-      readField (Field ("Conflicts", x)) (desc, unrecognized) = (setL (B.relations . B.conflicts) (rels x) desc, unrecognized)-      readField (Field ("Provides", x)) (desc, unrecognized) = (setL (B.relations . B.provides) (rels x) desc, unrecognized)-      readField (Field ("Replaces", x)) (desc, unrecognized) = (setL (B.relations . B.replaces) (rels x) desc, unrecognized)-      readField (Field ("Built-Using", x)) (desc, unrecognized) = (setL (B.relations . B.builtUsing) (rels x) desc, unrecognized)-      readField (Field ("Description", x)) (desc, unrecognized) = (setL B.description (Just (pack x)) desc, unrecognized)+      readField (Field ("Package", x)) (desc, unrecognized) = (set B.package (BinPkgName x) desc, unrecognized)+      readField (Field ("Architecture", x)) (desc, unrecognized) = (set B.architecture (Just (parsePackageArchitectures x)) desc, unrecognized)+      readField (Field ("Section", x)) (desc, unrecognized) = (set B.binarySection (Just (readSection x)) desc, unrecognized)+      readField (Field ("Priority", x)) (desc, unrecognized) = (set B.binaryPriority (Just (readPriority x)) desc, unrecognized)+      readField (Field ("Essential", x)) (desc, unrecognized) = (set B.essential (Just (yes x)) desc, unrecognized)+      readField (Field ("Depends", x)) (desc, unrecognized) = (set (B.relations . B.depends) (rels x) desc, unrecognized)+      readField (Field ("Recommends", x)) (desc, unrecognized) = (set (B.relations . B.recommends) (rels x) desc, unrecognized)+      readField (Field ("Suggests", x)) (desc, unrecognized) = (set (B.relations . B.suggests) (rels x) desc, unrecognized)+      readField (Field ("Pre-Depends", x)) (desc, unrecognized) = (set (B.relations . B.preDepends) (rels x) desc, unrecognized)+      readField (Field ("Breaks", x)) (desc, unrecognized) = (set (B.relations . B.breaks) (rels x) desc, unrecognized)+      readField (Field ("Conflicts", x)) (desc, unrecognized) = (set (B.relations . B.conflicts) (rels x) desc, unrecognized)+      readField (Field ("Provides", x)) (desc, unrecognized) = (set (B.relations . B.provides) (rels x) desc, unrecognized)+      readField (Field ("Replaces", x)) (desc, unrecognized) = (set (B.relations . B.replaces) (rels x) desc, unrecognized)+      readField (Field ("Built-Using", x)) (desc, unrecognized) = (set (B.relations . B.builtUsing) (rels x) desc, unrecognized)+      readField (Field ("Description", x)) (desc, unrecognized) = (set 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@@ -172,7 +172,7 @@ inputChangeLog :: MonadIO m => DebianT m () inputChangeLog =     do log <- liftIO $ tryIOError (readFile "debian/changelog" >>= return . parseChangeLog . unpack)-       changelog ~?= either (\ _ -> Nothing) Just log+       changelog .?= either (\ _ -> Nothing) Just log  inputCabalInfoFromDirectory :: MonadIO m => DebianT m () -- .install files, .init files, etc. inputCabalInfoFromDirectory =@@ -192,7 +192,7 @@           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)+             mapM_ (\ x -> intermediateFiles %= Set.insert x) (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.@@ -201,24 +201,24 @@ -- 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 <> pack "\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@"source/format" = liftIO (readFile (debian </> name)) >>= \ text -> either (\ x -> warning %= Set.insert x) ((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 <> pack "\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+    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, ".init") ->      liftIO (readFile (debian </> name)) >>= \ text -> installInit %= Map.insert p text+      (p, ".logrotate") -> liftIO (readFile (debian </> name)) >>= \ text -> logrotateStanza %= Map.insertWith mappend 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)+      (p, ".postinst") ->  liftIO (readFile (debian </> name)) >>= \ text -> postInst %= Map.insert p text+      (p, ".postrm") ->    liftIO (readFile (debian </> name)) >>= \ text -> postRm %= Map.insert p text+      (p, ".preinst") ->   liftIO (readFile (debian </> name)) >>= \ text -> preInst %= Map.insert p text+      (p, ".prerm") ->     liftIO (readFile (debian </> name)) >>= \ text -> preRm %= Map.insert p text       (_, ".log") ->       return () -- Generated by debhelper       (_, ".debhelper") -> return () -- Generated by debhelper       (_, ".hs") ->        return () -- Code that uses this library@@ -258,13 +258,13 @@ -- in the CABAL_DEBIAN_DATADIR environment variable. dataDest :: MonadIO m => CabalT m FilePath dataDest = do-  d <- access packageDescription+  d <- use packageDescription   return $ "usr/share" </> ((\ (PackageName x) -> x) $ pkgName $ Cabal.package d)  -- | Where to look for the data-files dataTop :: MonadIO m => CabalT m FilePath dataTop = do-  d <- access packageDescription+  d <- use packageDescription   return $ case Cabal.dataDir d of              "" -> "."              x -> x
src/Debian/Debianize/Monad.hs view
@@ -25,8 +25,7 @@     , unlessM     ) where -import OldLens (focus)-+import Control.Lens import Control.Monad.State (evalState, evalStateT, execState, execStateT, runState, State, StateT(runStateT)) import Debian.Debianize.DebInfo (DebInfo) import Debian.Debianize.CabalInfo (CabalInfo, debInfo)@@ -63,7 +62,7 @@ execDebianT = execStateT  liftCabal :: Monad m => StateT DebInfo m a -> StateT CabalInfo m a-liftCabal = focus debInfo+liftCabal = zoom debInfo  ifM :: Monad m => m Bool -> m a -> m a -> m a ifM m t f = m >>= \ b -> if b then t else f
src/Debian/Debianize/Options.hs view
@@ -8,18 +8,20 @@     , withEnvironmentArgs     ) where -import OldLens (focus, Lens) -import Control.Category ((.))+import Control.Lens import Control.Monad.State (StateT) import Control.Monad.Trans (liftIO, MonadIO) import Data.Char (isDigit, ord)+import Data.Map as Map (insert, insertWith)+import Data.Monoid (mappend)+import Data.Set as Set (insert) 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 (CabalT)-import Debian.Debianize.Prelude ((%=), (+++=), (++=), (+=), maybeRead, (~=))+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@@ -30,7 +32,7 @@ import Debian.Relation.String (parseRelations) import Debian.Version (parseDebianVersion) import Distribution.Package (PackageName(..))-import Prelude hiding ((.), lines, log, null, readFile, sum)+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)@@ -43,9 +45,9 @@ compileArgs args =     case getOpt' RequireOrder options args of       (os, [], [], []) -> sequence_ os-      (_, non, unk, errs) -> error ("Errors: " ++ show errs +++      (_, nonopt, unk, errs) -> error ("Errors: " ++ show errs ++                                     ", Unrecognized: " ++ show unk ++-                                    ", Non-Options: " ++ show non)+                                    ", Non-Options: " ++ show nonopt)  -- | Get a list of arguments from the CABALDEBIAN environment variable -- and apply them to the monadic state.@@ -75,36 +77,36 @@     [ 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 -> (A.debInfo . D.utilsPackageNameBase) ~= Just name) "NAME")+      Option "" ["default-package"] (ReqArg (\ name -> (A.debInfo . D.utilsPackageNameBase) .= 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 ((A.debInfo . D.noDocumentationLibrary) ~= True))+      Option "" ["disable-haddock"] (NoArg ((A.debInfo . D.noDocumentationLibrary) .= 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 -> (A.debInfo . D.missingDependencies) += (BinPkgName name)) "DEB")+      Option "" ["missing-dependency"] (ReqArg (\ name -> (A.debInfo . D.missingDependencies) %= Set.insert (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 -> (A.debInfo . D.overrideDebianNameBase) ~= (Just (DebBase name))) "NAME")+      Option "" ["debian-name-base"] (ReqArg (\ name -> (A.debInfo . D.overrideDebianNameBase) .= (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 -> (A.debInfo . D.sourcePackageName) ~= (Just (SrcPkgName name))) "NAME")+      Option "" ["source-package-name"] (ReqArg (\ name -> (A.debInfo . D.sourcePackageName) .= (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 -> (A.debInfo . D.control . S.section) ~= Just (read name)) "NAME")+      Option "" ["source-section"] (ReqArg (\ name -> (A.debInfo . D.control . S.section) .= Just (read name)) "NAME")              "Set the Section: field of the Debian source package.",-      Option "" ["disable-library-profiling"] (NoArg ((A.debInfo . D.noProfilingLibrary) ~= True))+      Option "" ["disable-library-profiling"] (NoArg ((A.debInfo . D.noProfilingLibrary) .= 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)) (((A.debInfo . D.maintainerOption) ~=) . Just) (parseMaintainer s)) "Maintainer Name <email addr>")+      Option "" ["maintainer"] (ReqArg (\ s -> either (error ("Invalid maintainer string: " ++ show s)) (((A.debInfo . D.maintainerOption) .=) . 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 -> (A.debInfo . D.uploadersOption) %= (\ l -> l ++ [x])) (parseMaintainer s)) "Uploader Name <email addr>")              (unlines [ "Add one entry to the uploader list"]),-      Option "" ["standards-version"] (ReqArg (\ sv -> (A.debInfo . D.control . S.standardsVersion) ~= Just (parseStandardsVersion sv)) "VERSION")+      Option "" ["standards-version"] (ReqArg (\ sv -> (A.debInfo . D.control . S.standardsVersion) .= 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 ->@@ -146,48 +148,48 @@              (ReqArg (addDep (\b -> binaryDebDescription b . B.relations . B.suggests)) "deb:deb,deb:deb,...")              "Like --depends, modifies the Suggests field.",       Option "" ["map-dep"] (ReqArg (\ pair -> case break (== '=') pair of-                                                 (cab, (_ : deb)) -> (A.debInfo . D.extraLibMap) +++= (cab, rels deb)+                                                 (cab, (_ : deb)) -> (A.debInfo . D.extraLibMap) %= Map.insertWith mappend 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 -> (A.debInfo . D.debVersion) ~= Just (parseDebianVersion version)) "VERSION")+      Option "" ["deb-version"] (ReqArg (\ version -> (A.debInfo . D.debVersion) .= 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 -> (A.debInfo . D.revision) ~= Just rev) "REVISION")+      Option "" ["revision"] (ReqArg (\ rev -> (A.debInfo . D.revision) .= 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 -> A.epochMap ++= (PackageName cab, ord d - ord '0')+                                  (cab, (_ : [d])) | isDigit d -> A.epochMap %= Map.insert (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)) -> (A.debInfo . D.execMap) ++= (cab, rels deb)+                                               (cab, (_ : deb)) -> (A.debInfo . D.execMap) %= Map.insert 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 ((A.debInfo . D.omitProfVersionDeps) ~= True))+      Option "" ["omit-prof-version-deps"] (NoArg ((A.debInfo . D.omitProfVersionDeps) .= True))              "Do not put the version dependencies on the prof packages that we put on the dev packages.",-      Option "" ["omit-lt-deps"] (NoArg ((A.debInfo . D.omitLTDeps) ~= True))+      Option "" ["omit-lt-deps"] (NoArg ((A.debInfo . D.omitLTDeps) .= 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 ((A.debInfo . D.sourceFormat) ~= Just Quilt3))+      Option "" ["quilt"] (NoArg ((A.debInfo . D.sourceFormat) .= Just Quilt3))              "The package has an upstream tarball, write '3.0 (quilt)' into source/format.",-      Option "" ["native"] (NoArg ((A.debInfo . D.sourceFormat) ~= Just Native3))+      Option "" ["native"] (NoArg ((A.debInfo . D.sourceFormat) .= Just Native3))              "The package has an no upstream tarball, write '3.0 (native)' into source/format.",-      Option "" ["official"] (NoArg ((A.debInfo . D.official) ~= True))+      Option "" ["official"] (NoArg ((A.debInfo . D.official) .= True))              "This packaging is created of the official Debian Haskell Group",-      Option "" ["builddir"] (ReqArg (\ s -> (A.debInfo . D.buildDir) ~= Just (s </> "build")) "PATH")+      Option "" ["builddir"] (ReqArg (\ s -> (A.debInfo . D.buildDir) .= 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-tests"] (NoArg ((A.debInfo . D.enableTests) ~= False))+      Option "" ["no-tests"] (NoArg ((A.debInfo . D.enableTests) .= False))              "Build the test suite.",-      Option "" ["no-run-tests"] (NoArg ((A.debInfo . D.runTests) ~= False))+      Option "" ["no-run-tests"] (NoArg ((A.debInfo . D.runTests) .= False))              "Run the test suite during the build.",-      Option "" ["allow-debian-self-build-deps"] (NoArg ((A.debInfo . D.allowDebianSelfBuildDeps) ~= True))+      Option "" ["allow-debian-self-build-deps"] (NoArg ((A.debInfo . D.allowDebianSelfBuildDeps) .= True))              (unlines [ "Set this to allow 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.  It is True by default so that packages which"@@ -200,9 +202,9 @@ liftOpt (Option chrs strs desc doc) = Option chrs strs (liftDesc desc) doc  liftDesc :: Monad m => ArgDescr (StateT Flags m ()) -> ArgDescr (CabalT m ())-liftDesc (NoArg x) = NoArg (focus (A.debInfo . flags) x)-liftDesc (ReqArg f s) = ReqArg (\ p -> focus (A.debInfo . flags) (f p)) s-liftDesc (OptArg f s) = OptArg (\ mp -> focus (A.debInfo . flags) (f mp)) s+liftDesc (NoArg x) = NoArg (zoom (A.debInfo . flags) x)+liftDesc (ReqArg f s) = ReqArg (\ p -> zoom (A.debInfo . flags) (f p)) s+liftDesc (OptArg f s) = OptArg (\ mp -> zoom (A.debInfo . flags) (f mp)) s  anyrel :: BinPkgName -> Relation anyrel x = Rel x Nothing Nothing@@ -222,7 +224,7 @@ -- 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 :: Monad m => (BinPkgName -> Lens' DebInfo Relations) -> String -> CabalT m () addDep lns arg = mapM_ (\ (b, rel) -> (A.debInfo . lns b) %= (++ [[rel]])) (parseDeps arg)  parseDeps :: String -> [(BinPkgName, Relation)]
src/Debian/Debianize/Output.hs view
@@ -14,11 +14,9 @@     , validateDebianization     ) where -import OldLens (getL) -import Control.Category ((.)) import Control.Exception as E (throw)-import Control.Lens (zoom)+import Control.Lens import Control.Monad.State (get, StateT) import Control.Monad.Trans (liftIO, MonadIO) import Data.Algorithm.DiffContext (getContextDiff, prettyContextDiff)@@ -38,7 +36,7 @@ import Debian.Debianize.BinaryDebDescription as B (canonical, package) import qualified Debian.Debianize.SourceDebDescription as S import Debian.Pretty (ppShow, ppPrint)-import Prelude hiding ((.), unlines, writeFile)+import Prelude hiding (unlines, writeFile) import System.Console.GetOpt (OptDescr, usageInfo) import System.Directory (createDirectoryIfMissing, doesFileExist, getPermissions, Permissions(executable), setPermissions) import System.Environment (getProgName)@@ -78,14 +76,14 @@ finishDebianization = zoom debInfo $     do new <- get        case () of-         _ | getL (D.flags . debAction) new == Usage ->+         _ | view (D.flags . debAction) new == Usage ->                do progName <- liftIO getProgName                   liftIO $ putStrLn (usageInfo (usageHeader progName) (options :: [OptDescr (StateT CabalInfo m ())]))-         _ | getL (D.flags . validate) new ->+         _ | view (D.flags . validate) new ->                do inputDebianization                   old <- get                   return $ validateDebianization old new-         _ | getL (D.flags . dryRun) new ->+         _ | view (D.flags . dryRun) new ->                do inputDebianization                   old <- get                   diff <- liftIO $ compareDebianization old new@@ -152,11 +150,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 D.changelog old))))-      newVersion = logVersion (head (unChangeLog (fromMaybe (error "Missing changelog") (getL D.changelog new))))-      oldSource = getL (D.control . S.source) old-      newSource = getL (D.control . S.source) new-      oldPackages = map (getL B.package) $ getL (D.control . S.binaryPackages) old-      newPackages = map (getL B.package) $ getL (D.control . S.binaryPackages) new+      oldVersion = logVersion (head (unChangeLog (fromMaybe (error "Missing changelog") (view D.changelog old))))+      newVersion = logVersion (head (unChangeLog (fromMaybe (error "Missing changelog") (view D.changelog new))))+      oldSource = view (D.control . S.source) old+      newSource = view (D.control . S.source) new+      oldPackages = map (view B.package) $ view (D.control . S.binaryPackages) old+      newPackages = map (view B.package) $ view (D.control . S.binaryPackages) new       unChangeLog :: ChangeLog -> [ChangeLogEntry]       unChangeLog (ChangeLog x) = x
src/Debian/Debianize/Prelude.hs view
@@ -32,34 +32,27 @@     , read'     , modifyM     , intToVerbosity'-    , (~=)-    , (~?=)-    , (%=)-    , (+=)-    , (++=)-    , (+++=)     , listElemLens     , maybeLens     , fromEmpty     , fromSingleton+    , (.?=)     ) where -import OldLens (getL, lens, Lens, modL, setL)-import qualified OldLens as Lens ((%=), (~=))  import Control.Applicative ((<$>))-import Control.Category ((.)) import Control.Exception as E (bracket, catch, throw, try)+import Control.Lens import Control.Monad (when) import Control.Monad.Reader (ask, ReaderT)-import Control.Monad.State (get, MonadState, put, StateT)+import Control.Monad.State (get, MonadState, StateT, put) import Data.Char (isSpace) 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.Map as Map (empty, findWithDefault, foldWithKey, fromList, insert, lookup, map, Map) import Data.Maybe (catMaybes, fromJust, fromMaybe, listToMaybe, mapMaybe)-import Data.Monoid ((<>), mappend, mconcat, Monoid)+import Data.Monoid ((<>), mconcat) import Data.Set as Set (Set, toList)-import qualified Data.Set as Set (findMin, fromList, insert, null, size)+import qualified Data.Set as Set (findMin, fromList, null, size) import Data.Text as Text (lines, Text, unpack) import Data.Text.IO (hGetContents) import Debian.Control (Field'(Field), lookupP, parseControl, stripWS, unControl)@@ -72,7 +65,7 @@ import Distribution.Package (PackageIdentifier(..), PackageName(..)) 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 Prelude hiding (lookup, map) import System.Directory (doesDirectoryExist, doesFileExist, getCurrentDirectory, getDirectoryContents, removeDirectory, removeFile, renameFile, setCurrentDirectory) import System.FilePath ((</>), dropExtension) import System.IO (hSetBinaryMode, IOMode(ReadMode), openFile, withFile)@@ -268,9 +261,9 @@ foldEmpty r _ [] = r foldEmpty _ f l = f l --- | If the current value of getL x is Nothing, replace it with f.-maybeL :: Lens a (Maybe b) -> Maybe b -> a -> a-maybeL l mb x = modL l (maybe mb Just) x+-- | If the current value of view x is Nothing, replace it with f.+maybeL :: Lens' a (Maybe b) -> Maybe b -> a -> a+maybeL l mb x = over l (maybe mb Just) x  indent :: [Char] -> String -> String indent prefix s = unlines (List.map (prefix ++) (List.lines s))@@ -296,34 +289,7 @@ intToVerbosity' :: Int -> Verbosity intToVerbosity' n = fromJust (intToVerbosity (max 0 (min 3 n))) --- | Set a lens value.  (This is a version of Data.Lens.Lazy.~= that returns () instead of b.)-(~=) :: Monad m => Lens a b -> b -> StateT a m ()-l ~= x = l Lens.~= x >> return ()---- | Set @b@ if it currently isNothing and the argument isJust, that is---  1. Nothing happens if the argument isNothing---  2. Nothing happens if the current value isJust-(~?=) :: Monad m => Lens a (Maybe b) -> Maybe b -> StateT a m ()-l ~?= (Just x) = l Lens.%= maybe (Just x) Just >> return ()-_ ~?= _ = return ()---- | Modify a value.  (This is a version of Data.Lens.Lazy.%= that returns () instead of a.)-(%=) :: Monad m => Lens a b -> (b -> b) -> StateT a m ()-l %= f = l Lens.%= f >> return ()---- | Insert an element into a @(Set b)@-(+=) :: (Monad m, Ord b) => Lens a (Set b) -> b -> StateT a m ()-l += x = l %= Set.insert x---- | Insert an element into a @(Map b c)@-(++=) :: (Monad m, Ord b) => Lens a (Map b c) -> (b, c) -> StateT a m ()-l ++= (k, a) = l %= Map.insert k a---- | Insert an element into a @(Map b (Set c))@-(+++=) :: (Monad m, Ord b, Monoid c) => Lens a (Map b c) -> (b, c) -> StateT a m ()-l +++= (k, a) = l %= Map.insertWith mappend k a--listElemLens :: (a -> Bool) -> Lens [a] (Maybe a)+listElemLens :: (a -> Bool) -> Lens' [a] (Maybe a) listElemLens p =     lens lensGet lensPut     where@@ -331,21 +297,21 @@           case span (not . p) xs of             (_, x : _) -> Just x             _ -> Nothing-      lensPut Nothing xs =+      lensPut xs Nothing  =           case span (not . p) xs of-            (pre, _ : post) -> pre ++ post+            (before, _ : after) -> before ++ after             _ -> xs-      lensPut (Just x) xs =+      lensPut xs (Just x) =           case span (not . p) xs of-            (pre, _ : post) -> pre ++ (x : post)+            (before, _ : after) -> before ++ (x : after)             _ -> xs ++ [x] -maybeLens :: a -> Lens a b -> Lens (Maybe a) b+maybeLens :: a -> Lens' a b -> Lens' (Maybe a) b maybeLens def l =-    lens (getL l . fromMaybe def)-         (\ a b -> case (a, b) of-                     (_, Nothing) -> Just (setL l a def)-                     (_, Just b') -> Just (setL l a b'))+    lens (\ x -> (fromMaybe def x) ^. l)+         (\ b a -> case (a, b) of+                     (_, Nothing) -> Just (l .~ a $ def)+                     (_, Just b') -> Just (l .~ a $ b'))  fromEmpty :: Set a -> Set a -> Set a fromEmpty d s | Set.null s = d@@ -363,3 +329,9 @@  instance Pretty (PP PackageName) where     pPrint (PP (PackageName s)) = text s++-- | Set @b@ if it currently isNothing and the argument isJust, that is+--  1. Nothing happens if the argument isNothing+--  2. Nothing happens if the current value isJust+(.?=) :: Monad m => Lens' a (Maybe b) -> Maybe b -> StateT a m ()+l .?= mx = use l >>= assign l . maybe mx Just
src/Debian/Policy.hs view
@@ -283,39 +283,39 @@ -- | Official Debian license types as described in -- <https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/#license-specification>. data License-    = Public_Domain	-- ^ No license required for any purpose; the work is not subject to copyright in any jurisdiction.-    | Apache		-- ^ Apache license 1.0, 2.0.-    | Artistic		-- ^ Artistic license 1.0, 2.0.-    | BSD_2_Clause	-- ^ Berkeley software distribution license, 2-clause version.-    | BSD_3_Clause	-- ^ Berkeley software distribution license, 3-clause version.-    | BSD_4_Clause	-- ^ Berkeley software distribution license, 4-clause version.-    | ISC		-- ^ Internet Software Consortium, sometimes also known as the OpenBSD License.-    | CC_BY		-- ^ Creative Commons Attribution license 1.0, 2.0, 2.5, 3.0.-    | CC_BY_SA		-- ^ Creative Commons Attribution Share Alike license 1.0, 2.0, 2.5, 3.0.-    | CC_BY_ND		-- ^ Creative Commons Attribution No Derivatives license 1.0, 2.0, 2.5, 3.0.-    | CC_BY_NC		-- ^ Creative Commons Attribution Non-Commercial license 1.0, 2.0, 2.5, 3.0.-    | CC_BY_NC_SA	-- ^ Creative Commons Attribution Non-Commercial Share Alike license 1.0, 2.0, 2.5, 3.0.-    | CC_BY_NC_ND	-- ^ Creative Commons Attribution Non-Commercial No Derivatives license 1.0, 2.0, 2.5, 3.0.-    | CC0		-- ^ Creative Commons Zero 1.0 Universal. Omit "Universal" from the license version when forming the short name.-    | CDDL		-- ^ Common Development and Distribution License 1.0.-    | CPL		-- ^ IBM Common Public License.-    | EFL		-- ^ The Eiffel Forum License 1.0, 2.0.-    | Expat		-- ^ The Expat license.-    | GPL		-- ^ GNU General Public License 1.0, 2.0, 3.0.-    | LGPL		-- ^ GNU Lesser General Public License 2.1, 3.0, or GNU Library General Public License 2.0.-    | GFDL		-- ^ GNU Free Documentation License 1.0, 1.1, 1.2, or 1.3. Use GFDL-NIV instead if there are no Front-Cover or Back-Cover Texts or Invariant Sections.-    | GFDL_NIV		-- ^ GNU Free Documentation License, with no Front-Cover or Back-Cover Texts or Invariant Sections. Use the same version numbers as GFDL.-    | LPPL		-- ^ LaTeX Project Public License 1.0, 1.1, 1.2, 1.3c.-    | MPL		-- ^ Mozilla Public License 1.1.-    | Perl		-- ^ erl license (use "GPL-1+ or Artistic-1" instead)-    | Python		-- ^ Python license 2.0.-    | QPL		-- ^ Q Public License 1.0.-    | W3C		-- ^ W3C Software License For more information, consult the W3C Intellectual Rights FAQ.-    | Zlib		-- ^ zlib/libpng license.-    | Zope		-- ^ Zope Public License 1.0, 1.1, 2.0, 2.1.+    = Public_Domain     -- ^ No license required for any purpose; the work is not subject to copyright in any jurisdiction.+    | Apache            -- ^ Apache license 1.0, 2.0.+    | Artistic          -- ^ Artistic license 1.0, 2.0.+    | BSD_2_Clause      -- ^ Berkeley software distribution license, 2-clause version.+    | BSD_3_Clause      -- ^ Berkeley software distribution license, 3-clause version.+    | BSD_4_Clause      -- ^ Berkeley software distribution license, 4-clause version.+    | ISC               -- ^ Internet Software Consortium, sometimes also known as the OpenBSD License.+    | CC_BY             -- ^ Creative Commons Attribution license 1.0, 2.0, 2.5, 3.0.+    | CC_BY_SA          -- ^ Creative Commons Attribution Share Alike license 1.0, 2.0, 2.5, 3.0.+    | CC_BY_ND          -- ^ Creative Commons Attribution No Derivatives license 1.0, 2.0, 2.5, 3.0.+    | CC_BY_NC          -- ^ Creative Commons Attribution Non-Commercial license 1.0, 2.0, 2.5, 3.0.+    | CC_BY_NC_SA       -- ^ Creative Commons Attribution Non-Commercial Share Alike license 1.0, 2.0, 2.5, 3.0.+    | CC_BY_NC_ND       -- ^ Creative Commons Attribution Non-Commercial No Derivatives license 1.0, 2.0, 2.5, 3.0.+    | CC0               -- ^ Creative Commons Zero 1.0 Universal. Omit "Universal" from the license version when forming the short name.+    | CDDL              -- ^ Common Development and Distribution License 1.0.+    | CPL               -- ^ IBM Common Public License.+    | EFL               -- ^ The Eiffel Forum License 1.0, 2.0.+    | Expat             -- ^ The Expat license.+    | GPL               -- ^ GNU General Public License 1.0, 2.0, 3.0.+    | LGPL              -- ^ GNU Lesser General Public License 2.1, 3.0, or GNU Library General Public License 2.0.+    | GFDL              -- ^ GNU Free Documentation License 1.0, 1.1, 1.2, or 1.3. Use GFDL-NIV instead if there are no Front-Cover or Back-Cover Texts or Invariant Sections.+    | GFDL_NIV          -- ^ GNU Free Documentation License, with no Front-Cover or Back-Cover Texts or Invariant Sections. Use the same version numbers as GFDL.+    | LPPL              -- ^ LaTeX Project Public License 1.0, 1.1, 1.2, 1.3c.+    | MPL               -- ^ Mozilla Public License 1.1.+    | Perl              -- ^ erl license (use "GPL-1+ or Artistic-1" instead)+    | Python            -- ^ Python license 2.0.+    | QPL               -- ^ Q Public License 1.0.+    | W3C               -- ^ W3C Software License For more information, consult the W3C Intellectual Rights FAQ.+    | Zlib              -- ^ zlib/libpng license.+    | Zope              -- ^ Zope Public License 1.0, 1.1, 2.0, 2.1.     | OtherLicense String-			-- ^ A license name associated with the subsequent text of the License: field or in-			-- a Files paragraph of the same debian/copyright file, or in a License: paragraph.+                        -- ^ A license name associated with the subsequent text of the License: field or in+                        -- a Files paragraph of the same debian/copyright file, or in a License: paragraph.     deriving (Read, Show, Eq, Ord, Data, Typeable)  -- We need a license parse function that converts these strings back@@ -358,19 +358,19 @@ fromCabalLicense :: Cabal.License -> License fromCabalLicense x =     case x of-      Cabal.GPL mver -> GPL -- FIXME - what about the version number?  same below-      Cabal.AGPL mver -> OtherLicense (show x)-      Cabal.LGPL mver -> LGPL+      Cabal.GPL _ -> GPL -- FIXME - what about the version number?  same below+      Cabal.AGPL _ -> OtherLicense (show x)+      Cabal.LGPL _ -> LGPL       Cabal.BSD3 -> BSD_3_Clause       Cabal.BSD4 -> BSD_4_Clause       Cabal.MIT -> OtherLicense (show x)-      Cabal.Apache mver -> Apache+      Cabal.Apache _ -> Apache       Cabal.PublicDomain -> Public_Domain       Cabal.AllRightsReserved -> OtherLicense "AllRightsReserved"       Cabal.OtherLicense -> OtherLicense (show x)-      Cabal.UnknownLicense s -> OtherLicense (show x)+      Cabal.UnknownLicense _ -> OtherLicense (show x) #if MIN_VERSION_Cabal(1,20,0)-      Cabal.MPL ver -> MPL+      Cabal.MPL _ -> MPL #if MIN_VERSION_Cabal(1,22,0)       Cabal.BSD2 -> BSD_2_Clause       Cabal.ISC -> OtherLicense (show x)
− src/OldLens.hs
@@ -1,68 +0,0 @@--- | Temporary wrappers for conversion from data-lens package to lens.--- Uses of these should eventually be inlined and this module moved--- elsewhere.-{-# LANGUAGE Rank2Types, GADTs #-}-module OldLens-    ( Lens-    , lens-    , OldLens.iso-    , getL-    , setL-    , modL-    , access-    , focus-    , (OldLens.%=)-    , (OldLens.~=)-    ) where--import Control.Monad.State (StateT, get, put)-import Control.Lens hiding (Lens, lens)-import Control.Lens.Internal.Zoom (Zoomed)-import qualified Control.Lens (lens)---- Need to reverse order of compositions--- Need to add {-# LANGUAGE Rank2Types #-} to some modules--- If you use fancy name functions with nameMakeLens you need---   to convert your types to simple "starts with _" format, and you need---   to call makeLenses for each type name individually.--type Lens a b = Lens' a b--lens :: (a -> b) -> (b -> a -> a) -> Lens a b-lens getter setter = Control.Lens.lens getter (flip setter)--iso :: (a -> b) -> (b -> a) -> Lens a b-iso = Control.Lens.iso--getL :: Lens a b -> a -> b-getL lns x = x ^. lns -- view lns x--setL :: Lens a b -> b -> a -> a-setL lns y x = set lns y x--modL :: Lens a b -> (b -> b) -> a -> a-modL lns f x = set lns (f (view lns x)) x--access :: Monad m => Lens a b -> StateT a m b-access lns = get >>= return Prelude.. view lns--(~=) :: Monad m => Lens a b -> b -> StateT a m ()-lns ~= y = get >>= \x -> put (set lns y x)--(%=) :: Monad m => Lens a b -> (b -> b) -> StateT a m ()-lns %= f = get >>= \x -> put (set lns (f (getL lns x)) x)---- focus :: Monad m => Lens a b -> StateT b m c -> StateT a m c---focus (Lens f) (StateT g) = StateT $ \a -> case f a of---  StoreT (Identity h) b -> liftM (second h) (g b)-focus :: forall m n s t c. (Zoom m n s t, Zoomed n ~ Zoomed m) => LensLike' (Zoomed m c) t s -> m c -> n c-focus lns st = zoom lns st--{--Couldn't match type- ‘(b -> Zoomed (StateT b m) c b) -> a -> Zoomed (StateT b m) c a’-                  with- ‘forall (f :: * -> *). Functor f => (b -> f b) -> a -> f a’-    Expected type: Lens a b -> StateT b m c -> StateT a m c-      Actual type: LensLike' (Zoomed (StateT b m) c) a b -> StateT b m c -> StateT a m c--}
test-data/artvaluereport2/input/debian/Debianize.hs view
@@ -1,20 +1,13 @@ {-# LANGUAGE CPP, OverloadedStrings #-} -import OldLens hiding ((~=), (%=)) +import Control.Lens import Data.Maybe (fromMaybe) import Data.Monoid (mempty) import Data.Set as Set (singleton, insert) import Data.Text as Text (intercalate) import Debian.Changes (ChangeLog(..)) import Debian.Debianize -- (debianize, doBackups, doExecutable, doServer, doWebsite, inputChangeLog, inputDebianization, debianDefaultAtoms)--- import Debian.Debianize.BasicFlags (newFlags)--- import qualified Debian.Debianize.Atoms as A--- import Debian.Debianize.Atoms (Atoms, Atom(..), newAtoms, InstallFile(..), Server(..), Site(..), DebInfo, debInfo, atomSet, makeDebInfo)--- import Debian.Debianize.Monad (execCabalT, evalCabalT, CabalT, liftCabal, execDebianT)--- import Debian.Debianize.SourceDebDescription (SourceDebDescription)--- import Debian.Debianize.Output (compareDebianization)--- import Debian.Debianize.Prelude ((~=), (%=), (+=), (++=), (+++=), (~?=), withCurrentDirectory) import Debian.Pretty (ppShow) import Debian.Policy (databaseDirectory, PackageArchitectures(All), StandardsVersion(StandardsVersion)) import Debian.Relation (BinPkgName(BinPkgName), Relation(Rel), SrcPkgName(..), VersionReq(SLT))@@ -27,18 +20,18 @@ -- to copyFirstLogEntry in real life, this is to make sure old and new match. main :: IO () main =-    do log <- withCurrentDirectory "test-data/artvaluereport2/input" $ newFlags >>= newCabalInfo >>= evalCabalT (liftCabal inputChangeLog >> access (debInfo . changelog))+    do log <- withCurrentDirectory "test-data/artvaluereport2/input" $ newFlags >>= newCabalInfo >>= evalCabalT (liftCabal inputChangeLog >> use (debInfo . changelog))        new <- withCurrentDirectory "test-data/artvaluereport2/input" $ newFlags >>= newCabalInfo >>= execCabalT (debianize (debianDefaults >> customize log {- >> removeFirstLogEntry -}))        old <- withCurrentDirectory "test-data/artvaluereport2/output" $ newFlags >>= execDebianT inputDebianization . makeDebInfo        -- The newest log entry gets modified when the Debianization is        -- generated, it won't match so drop it for the comparison.-       compareDebianization old ({-copyFirstLogEntry old $ -} getL debInfo new) >>= putStr+       compareDebianization old ({-copyFirstLogEntry old $ -} view debInfo new) >>= putStr     where       customize :: Maybe ChangeLog -> CabalT IO ()       customize log =-          do (debInfo . revision) ~= Nothing-             (debInfo . sourceFormat) ~= Just Native3-             (debInfo . changelog) ~?= log+          do (debInfo . revision) .= Nothing+             (debInfo . sourceFormat) .= Just Native3+             (debInfo . changelog) .?= log              (debInfo . atomSet) %= (Set.insert $ InstallCabalExec (BinPkgName "appraisalscope") "lookatareport" "usr/bin")              doExecutable (BinPkgName "appraisalscope") (InstallFile {execName = "appraisalscope", sourceDir = Nothing, destDir = Nothing, destName = "appraisalscope"})              doServer (BinPkgName "artvaluereport2-development") (theServer (BinPkgName "artvaluereport2-development"))@@ -47,7 +40,7 @@              doBackups (BinPkgName "artvaluereport2-backups") "artvaluereport2-backups"              -- This should go into the "real" data directory.  And maybe a different icon for each server?              -- install (BinPkgName "artvaluereport2-server") ("theme/ArtValueReport_SunsetSpectrum.ico", "usr/share/artvaluereport2-data")-             (debInfo . binaryDebDescription (BinPkgName "artvaluereport2-backups") . description) ~=+             (debInfo . binaryDebDescription (BinPkgName "artvaluereport2-backups") . description) .=                      Just (Text.intercalate "\n"                                   [ "backup program for the appraisalreportonline.com site"                                   , "  Install this somewhere other than where the server is running get"@@ -55,18 +48,18 @@              addDep (BinPkgName "artvaluereport2-production") (BinPkgName "apache2")              addServerData              addServerDeps-             (debInfo . binaryDebDescription (BinPkgName "appraisalscope") . description) ~= Just "Offline manipulation of appraisal database"+             (debInfo . binaryDebDescription (BinPkgName "appraisalscope") . description) .= Just "Offline manipulation of appraisal database"              (debInfo . control . buildDependsIndep) %= (++ [[Rel (BinPkgName "libjs-jquery-ui") (Just (SLT (parseDebianVersion ("1.10" :: String)))) Nothing]])              (debInfo . control . buildDependsIndep) %= (++ [[Rel (BinPkgName "libjs-jquery") Nothing Nothing]])              (debInfo . control . buildDependsIndep) %= (++ [[Rel (BinPkgName "libjs-jcrop") Nothing Nothing]])-             (debInfo . binaryDebDescription (BinPkgName "artvaluereport2-staging") . architecture) ~= Just All-             (debInfo . binaryDebDescription (BinPkgName "artvaluereport2-production") . architecture) ~= Just All-             (debInfo . binaryDebDescription (BinPkgName "artvaluereport2-development") . architecture) ~= Just All+             (debInfo . binaryDebDescription (BinPkgName "artvaluereport2-staging") . architecture) .= Just All+             (debInfo . binaryDebDescription (BinPkgName "artvaluereport2-production") . architecture) .= Just All+             (debInfo . binaryDebDescription (BinPkgName "artvaluereport2-development") . architecture) .= Just All              -- utilsPackageNames [BinPkgName "artvaluereport2-server"]-             (debInfo . sourcePackageName) ~= Just (SrcPkgName "haskell-artvaluereport2")-             (debInfo . control . standardsVersion) ~= Just (StandardsVersion 3 9 6 Nothing)-             (debInfo . control . homepage) ~= Just "http://appraisalreportonline.com"-             (debInfo . compat) ~= Just 9+             (debInfo . sourcePackageName) .= Just (SrcPkgName "haskell-artvaluereport2")+             (debInfo . control . standardsVersion) .= Just (StandardsVersion 3 9 6 Nothing)+             (debInfo . control . homepage) .= Just "http://appraisalreportonline.com"+             (debInfo . compat) .= Just 9        addServerDeps :: CabalT IO ()       addServerDeps = mapM_ addDeps (map BinPkgName ["artvaluereport2-development", "artvaluereport2-staging", "artvaluereport2-production"])@@ -137,7 +130,7 @@  copyFirstLogEntry :: DebInfo -> DebInfo -> DebInfo copyFirstLogEntry deb1 deb2 =-    modL changelog (const (Just (ChangeLog (hd1 : tl2)))) deb2+    over changelog (const (Just (ChangeLog (hd1 : tl2)))) deb2     where-      ChangeLog (hd1 : _) = fromMaybe (error "Missing debian/changelog") (getL changelog deb1)-      ChangeLog (_ : tl2) = fromMaybe (error "Missing debian/changelog") (getL changelog deb2)+      ChangeLog (hd1 : _) = fromMaybe (error "Missing debian/changelog") (view changelog deb1)+      ChangeLog (_ : tl2) = fromMaybe (error "Missing debian/changelog") (view changelog deb2)