cabal-debian-4.31/0000755000000000000000000000000012565162075012122 5ustar0000000000000000cabal-debian-4.31/Tests.hs0000644000000000000000000014040512565162075013564 0ustar0000000000000000{-# LANGUAGE CPP, OverloadedStrings, RankNTypes, ScopedTypeVariables, StandaloneDeriving #-} {-# OPTIONS_GHC -Wall -fno-warn-orphans #-} module Main ( tests , main ) where import Control.Applicative ((<$>)) import Debian.Debianize.Optparse(_flags, parseProgramArguments) import Control.Lens import Data.Algorithm.DiffContext (getContextDiff, prettyContextDiff) import Data.Function (on) import Data.List (sortBy) 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) import Data.Set as Set (fromList, union, insert) import Data.Text as Text (intercalate, split, Text, unlines, unpack) import Data.Version (Version(Version)) import Debian.Changes (ChangeLog(..), ChangeLogEntry(..), parseEntry) import Debian.Debianize.BasicInfo (compilerFlavor, Flags) import qualified Debian.Debianize.BinaryDebDescription as B import Debian.Debianize.CabalInfo as A import Debian.Debianize.CopyrightDescription import Debian.Debianize.DebianName (mapCabal, splitCabal) import qualified Debian.Debianize.DebInfo as D import Debian.Debianize.Files (debianizationFileMap) import Debian.Debianize.Finalize (debianize {-, finalizeDebianization-}) import Debian.Debianize.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 qualified Debian.Debianize.SourceDebDescription as S import Debian.Debianize.VersionSplits (DebBase(DebBase)) import Debian.Pretty (ppShow) import Debian.Policy (databaseDirectory, PackageArchitectures(All), PackagePriority(Extra), parseMaintainer, Section(MainSection), SourceFormat(Native3), StandardsVersion(..), getDebhelperCompatLevel, getDebianStandardsVersion, License(..)) import Debian.Relation (BinPkgName(..), Relation(..), SrcPkgName(..), VersionReq(..)) import Debian.Release (ReleaseName(ReleaseName, relName)) import Debian.Version (parseDebianVersion, buildDebianVersion) import Distribution.Compiler (CompilerFlavor(GHC)) import Distribution.Package (PackageName(PackageName)) import Prelude hiding (log) import System.Exit (ExitCode(ExitSuccess)) import System.FilePath (()) import System.Process (readProcessWithExitCode) import Test.HUnit import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr(..)) import Text.PrettyPrint.HughesPJClass (pPrint, text, Doc) -- | Backward compatibility. Should be fixed. newFlags :: IO Flags newFlags = _flags <$> parseProgramArguments -- | A suitable defaultAtoms value for the debian repository. defaultAtoms :: Monad m => CabalT m () defaultAtoms = 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") splitCabal (PackageName "QuickCheck") (DebBase "quickcheck1") (Version [2] []) mapCabal (PackageName "gtk2hs-buildtools") (DebBase "gtk2hs-buildtools") -- | Force the compiler version to 7.6 to get predictable outputs testAtoms :: IO CabalInfo testAtoms = newFlags >>= newCabalInfo >>= return . ghc763 where ghc763 :: CabalInfo -> CabalInfo 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 -- debian-policy to set the compatibility levels. 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 Right (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 tests :: Test tests = TestLabel "Debianization Tests" (TestList [-- 1 and 2 do not input a cabal package - we're not ready to -- debianize without a cabal package. {- test1 "test1", test2 "test2", -} -- test3 "test3", -- not a cabal package test4 "test4 - test-data/clckwrks-dot-com", test5 "test5 - test-data/creativeprompts", test6 "test6 - test-data/artvaluereport2", test7 "test7 - debian/Debianize.hs", test8 "test8 - test-data/artvaluereport-data", test9 "test9 - test-data/alex", test10 "test10 - test-data/archive" {- , issue23 "issue23" -}]) issue23 :: String -> Test issue23 label = 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 Map.toList <$> liftCabal debianizationFileMap) atoms assertEqual label [] actual) #if 0 test1 :: String -> Test test1 label = TestLabel label $ TestCase (do level <- getDebhelperCompatLevel standards <- getDebianStandardsVersion :: IO (Maybe StandardsVersion) atoms <- testAtoms deb <- execCabalT (do -- let top = Top "." defaultAtoms newDebianization (ChangeLog [testEntry]) level standards (D.copyright . debInfo) %= (\ f -> (\ pkgDesc -> f pkgDesc >>= \ c -> return $ c { _summaryLicense = Just BSD_3_Clause })) -- inputCabalization top finalizeDebianization) atoms diff <- diffDebianizations (view debInfo (testDeb1 atoms)) (view debInfo deb) assertEqual label [] diff) where testDeb1 :: CabalInfo -> CabalInfo testDeb1 atoms = execCabalM (do defaultAtoms newDebianization log (Just 9) (Just (StandardsVersion 3 9 3 (Just 1))) (D.rulesHead . debInfo) %= (const (Just (Text.unlines $ [ "#!/usr/bin/make -f" , "" , "include /usr/share/cdbs/1/rules/debhelper.mk" , "include /usr/share/cdbs/1/class/hlibrary.mk" ]))) (D.compat . debInfo) .= Just 9 -- This will change as new version of debhelper are released (D.copyright . debInfo) %= (\ f -> (\ pkgDesc -> f pkgDesc >>= \ c -> return $ c { _summaryLicense = Just BSD_3_Clause })) (S.source . D.control . debInfo) .= Just (SrcPkgName {unSrcPkgName = "haskell-cabal-debian"}) (S.maintainer . D.control . debInfo) .= Just (NameAddr (Just "David Fox") "dsf@seereason.com") (S.standardsVersion . D.control . debInfo) .= Just (StandardsVersion 3 9 3 (Just 1)) -- This will change as new versions of debian-policy are released (S.buildDepends . D.control . debInfo) %= (++ [[Rel (BinPkgName "debhelper") (Just (GRE (parseDebianVersion ("9" :: String)))) Nothing], [Rel (BinPkgName "haskell-devscripts") (Just (GRE (parseDebianVersion ("0.9" :: String)))) Nothing], [Rel (BinPkgName "cdbs") Nothing Nothing], [Rel (BinPkgName "ghc") Nothing Nothing], [Rel (BinPkgName "ghc-prof") Nothing Nothing]]) (S.buildDependsIndep . D.control . debInfo) %= (++ [[Rel (BinPkgName "ghc-doc") Nothing Nothing]])) atoms log = ChangeLog [Entry { logPackage = "haskell-cabal-debian" , logVersion = buildDebianVersion Nothing "2.6.2" Nothing , logDists = [ReleaseName {relName = "unstable"}] , logUrgency = "low" , logComments = " * Fix a bug constructing the destination pathnames that was dropping\n files that were supposed to be installed into packages.\n" , logWho = "David Fox " , logDate = "Thu, 20 Dec 2012 06:49:25 -0800" }] test2 :: String -> Test test2 label = TestLabel label $ TestCase (do level <- getDebhelperCompatLevel standards <- getDebianStandardsVersion atoms <- testAtoms deb <- execCabalT (do -- let top = Top "." defaultAtoms newDebianization (ChangeLog [testEntry]) level standards (D.copyright . debInfo) %= (\ f -> (\ pkgDesc -> f pkgDesc >>= \ c -> return $ c { _summaryLicense = Just BSD_3_Clause })) -- inputCabalization top finalizeDebianization) atoms diff <- diffDebianizations (view debInfo (expect atoms)) (view debInfo deb) assertEqual label [] diff) where expect atoms = execCabalM (do defaultAtoms newDebianization log (Just 9) (Just (StandardsVersion 3 9 3 (Just 1))) (D.rulesHead . debInfo) %= (const (Just (Text.unlines $ ["#!/usr/bin/make -f", "", "include /usr/share/cdbs/1/rules/debhelper.mk", "include /usr/share/cdbs/1/class/hlibrary.mk"]))) (D.compat . debInfo) .= Just 9 (D.copyright . debInfo) %= (\ f -> (\ pkgDesc -> f pkgDesc >>= \ c -> return $ c { _summaryLicense = Just BSD_3_Clause })) (S.source . D.control . debInfo) .= Just (SrcPkgName {unSrcPkgName = "haskell-cabal-debian"}) (S.maintainer . D.control . debInfo) .= Just (NameAddr {nameAddr_name = Just "David Fox", nameAddr_addr = "dsf@seereason.com"}) (S.standardsVersion . D.control . debInfo) .= Just (StandardsVersion 3 9 3 (Just 1)) (S.buildDepends . D.control . debInfo) %= (++ [[Rel (BinPkgName "debhelper") (Just (GRE (parseDebianVersion ("7.0" :: String)))) Nothing], [Rel (BinPkgName "haskell-devscripts") (Just (GRE (parseDebianVersion ("0.8" :: String)))) Nothing], [Rel (BinPkgName "cdbs") Nothing Nothing], [Rel (BinPkgName "ghc") Nothing Nothing], [Rel (BinPkgName "ghc-prof") Nothing Nothing]]) (S.buildDependsIndep . D.control . debInfo) %= (++ [[Rel (BinPkgName "ghc-doc") Nothing Nothing]])) atoms log = ChangeLog [Entry {logPackage = "haskell-cabal-debian", logVersion = Debian.Version.parseDebianVersion ("2.6.2" :: String), logDists = [ReleaseName {relName = "unstable"}], logUrgency = "low", logComments = Prelude.unlines [" * Fix a bug constructing the destination pathnames that was dropping", " files that were supposed to be installed into packages."], logWho = "David Fox ", logDate = "Thu, 20 Dec 2012 06:49:25 -0800"}] #endif testEntry :: ChangeLogEntry testEntry = either (error "Error in test changelog entry") fst (parseEntry (Prelude.unlines [ "haskell-cabal-debian (2.6.2) unstable; urgency=low" , "" , " * Fix a bug constructing the destination pathnames that was dropping" , " files that were supposed to be installed into packages." , "" , " -- David Fox Thu, 20 Dec 2012 06:49:25 -0800" ])) test3 :: String -> Test test3 label = TestLabel label $ TestCase (let top = "test-data/haskell-devscripts" in withCurrentDirectory top $ do atoms <- testAtoms deb <- (execCabalT (liftCabal inputDebianization) atoms) diff <- diffDebianizations (view debInfo (testDeb2 atoms)) (view debInfo deb) assertEqual label [] diff) where testDeb2 :: CabalInfo -> CabalInfo testDeb2 atoms = execCabalM (do defaultAtoms newDebianization log (Just 7) (Just (StandardsVersion 3 9 4 Nothing)) (debInfo . D.sourceFormat) .= Native3 (debInfo . D.rulesHead) .= Just (Text.unlines ["#!/usr/bin/make -f", "# -*- makefile -*-", "", "# Uncomment this to turn on verbose mode.", "#export DH_VERBOSE=1", "", "DEB_VERSION := $(shell dpkg-parsechangelog | egrep '^Version:' | cut -f 2 -d ' ')", "", "manpages = $(shell cat debian/manpages)", "", "%.1: %.pod", "\tpod2man -c 'Haskell devscripts documentation' -r 'Haskell devscripts $(DEB_VERSION)' $< > $@", "", "%.1: %", "\tpod2man -c 'Haskell devscripts documentation' -r 'Haskell devscripts $(DEB_VERSION)' $< > $@", "", ".PHONY: build", "build: $(manpages)", "", "install-stamp:", "\tdh install", "", ".PHONY: install", "install: install-stamp", "", "binary-indep-stamp: install-stamp", "\tdh binary-indep", "\ttouch $@", "", ".PHONY: binary-indep", "binary-indep: binary-indep-stamp", "", ".PHONY: binary-arch", "binary-arch: install-stamp", "", ".PHONY: binary", "binary: binary-indep-stamp", "", ".PHONY: clean", "clean:", "\tdh clean", "\trm -f $(manpages)", "", ""]) (debInfo . D.compat) .= Just 9 (debInfo . D.copyright) %= (Just . id . fromMaybe (readCopyrightDescription "This package was debianized by John Goerzen 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) .= Right (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.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) .= Just (intercalate "\n" ["Tools to help Debian developers build Haskell packages", " This package provides a collection of scripts to help build Haskell", " packages for Debian. Unlike haskell-utils, this package is not", " expected to be installed on the machines of end users.", " .", " This package is designed to support Cabalized Haskell libraries. It", " is designed to build a library for each supported Debian compiler or", " 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) .= [ [Rel (BinPkgName {unBinPkgName = "dctrl-tools"}) Nothing Nothing] , [Rel (BinPkgName {unBinPkgName = "debhelper"}) Nothing Nothing] , [Rel (BinPkgName {unBinPkgName = "dh-buildinfo"}) Nothing Nothing] , [Rel (BinPkgName {unBinPkgName = "ghc"}) (Just (GRE (Debian.Version.parseDebianVersion ("7.6" :: String)))) Nothing] , [Rel (BinPkgName {unBinPkgName = "cdbs"}) Nothing Nothing] , [Rel (BinPkgName {unBinPkgName = "${misc:Depends}"}) Nothing Nothing] , [Rel (BinPkgName {unBinPkgName = "html-xml-utils"}) Nothing Nothing] , [Rel (BinPkgName {unBinPkgName = "hscolour"}) (Just (GRE (Debian.Version.parseDebianVersion ("1.8" :: String)))) Nothing] , [Rel (BinPkgName {unBinPkgName = "ghc-haddock"}) (Just (GRE (Debian.Version.parseDebianVersion ("7.4" :: String)))) Nothing] ] {- control %= (\ y -> y { S.source = , S.maintainer = Just (NameAddr {nameAddr_name = Just "Debian Haskell Group", nameAddr_addr = "pkg-haskell-maintainers@lists.alioth.debian.org"}) , S.uploaders = [NameAddr {nameAddr_name = Just "Marco Silva", nameAddr_addr = "marcot@debian.org"},NameAddr {nameAddr_name = Just "Joachim Breitner", nameAddr_addr = "nomeata@debian.org"}] , S.priority = Just Extra , S.section = Just (MainSection "haskell") , S.buildDepends = (S.buildDepends y) ++ [[Rel (BinPkgName {unBinPkgName = "debhelper"}) (Just (GRE (Debian.Version.parseDebianVersion ("7" :: String)))) Nothing]] , S.buildDependsIndep = (S.buildDependsIndep y) ++ [[Rel (BinPkgName {unBinPkgName = "perl"}) Nothing Nothing]] , S.standardsVersion = Just (StandardsVersion 3 9 4 Nothing) , S.vcsFields = Set.union (S.vcsFields y) (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"]) , S.binaryPackages = [S.BinaryDebDescription { B.package = BinPkgName {unBinPkgName = "haskell-devscripts"} , B.architecture = All , B.binarySection = Nothing , B.binaryPriority = Nothing , B.essential = False , B.description = Just $ (T.intercalate "\n" ["Tools to help Debian developers build Haskell packages", " This package provides a collection of scripts to help build Haskell", " packages for Debian. Unlike haskell-utils, this package is not", " expected to be installed on the machines of end users.", " .", " This package is designed to support Cabalized Haskell libraries. It", " is designed to build a library for each supported Debian compiler or", " 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."]) , B.relations = B.PackageRelations { B.depends = [ [Rel (BinPkgName {unBinPkgName = "dctrl-tools"}) Nothing Nothing] , [Rel (BinPkgName {unBinPkgName = "debhelper"}) Nothing Nothing] , [Rel (BinPkgName {unBinPkgName = "dh-buildinfo"}) Nothing Nothing] , [Rel (BinPkgName {unBinPkgName = "ghc"}) (Just (GRE (Debian.Version.parseDebianVersion ("7.6" :: String)))) Nothing] , [Rel (BinPkgName {unBinPkgName = "cdbs"}) Nothing Nothing] , [Rel (BinPkgName {unBinPkgName = "${misc:Depends}"}) Nothing Nothing] , [Rel (BinPkgName {unBinPkgName = "html-xml-utils"}) Nothing Nothing] , [Rel (BinPkgName {unBinPkgName = "hscolour"}) (Just (GRE (Debian.Version.parseDebianVersion ("1.8" :: String)))) Nothing] , [Rel (BinPkgName {unBinPkgName = "ghc-haddock"}) (Just (GRE (Debian.Version.parseDebianVersion ("7.4" :: String)))) Nothing] ] , B.recommends = [] , B.suggests = [] , B.preDepends = [] , B.breaks = [] , B.conflicts = [] , B.provides_ = [] , B.replaces_ = [] , B.builtUsing = [] }}]}) -} ) atoms log = ChangeLog [Entry { logPackage = "haskell-devscripts" , logVersion = Debian.Version.parseDebianVersion ("0.8.13" :: String) , logDists = [ReleaseName {relName = "experimental"}] , logUrgency = "low" , logComments = " [ Joachim Breitner ]\n * Improve parsing of \"Setup register\" output, patch by David Fox\n * Enable creation of hoogle files, thanks to Kiwamu Okabe for the\n suggestion. \n\n [ Kiwamu Okabe ]\n * Need --html option to fix bug that --hoogle option don't output html file.\n * Support to create /usr/lib/ghc-doc/hoogle/*.txt for hoogle package.\n\n [ Joachim Breitner ]\n * Symlink hoogle\8217s txt files to /usr/lib/ghc-doc/hoogle/\n * Bump ghc dependency to 7.6 \n * Bump standards version\n" , logWho = "Joachim Breitner " , logDate = "Mon, 08 Oct 2012 21:14:50 +0200" }, Entry { logPackage = "haskell-devscripts" , logVersion = Debian.Version.parseDebianVersion ("0.8.12" :: String) , logDists = [ReleaseName {relName = "unstable"}] , logUrgency = "low" , logComments = " * Depend on ghc >= 7.4, adjusting to its haddock --interface-version\n behaviour.\n" , logWho = "Joachim Breitner " , logDate = "Sat, 04 Feb 2012 10:50:33 +0100"}] test4 :: String -> Test test4 label = TestLabel label $ TestCase (do let outTop = "test-data/clckwrks-dot-com/output" let inTop = "test-data/clckwrks-dot-com/input" atoms <- withCurrentDirectory inTop $ testAtoms old <- withCurrentDirectory outTop $ do execCabalT (liftCabal inputDebianization) atoms let log = view (debInfo . D.changelog) old new <- withCurrentDirectory inTop $ do execCabalT (debianize (defaultAtoms >> customize log)) atoms 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 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) %= Set.insert (BinPkgName "libghc-clckwrks-theme-clckwrks-doc") (A.debInfo . D.sourceFormat) .= 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))) . 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 . set T.changelog log -} -- A log entry gets added when the Debianization is generated, -- it won't match so drop it for the comparison. serverNames = map BinPkgName ["clckwrks-dot-com-production"] -- , "clckwrks-dot-com-staging", "clckwrks-dot-com-development"] -- Insert a line just above the debhelper.mk include fixRules = (debInfo . D.rulesSettings) %= (++ ["DEB_SETUP_GHC_CONFIGURE_ARGS = -fbackups"]) {- mapAtoms f deb where f :: DebAtomKey -> DebAtom -> Set (DebAtomKey, DebAtom) f Source (DebRulesHead t) = singleton (Source, DebRulesHead (T.unlines $ concat $ map (\ line -> if line == "include /usr/share/cdbs/1/rules/debhelper.mk" then ["DEB_SETUP_GHC_CONFIGURE_ARGS = -fbackups", "", line] :: [T.Text] else [line] :: [T.Text]) (T.lines t))) f k a = singleton (k, a) -} tight = mapM_ (tightDependencyFixup [(BinPkgName "libghc-clckwrks-theme-clckwrks-dev", BinPkgName "haskell-clckwrks-theme-clckwrks-utils"), (BinPkgName "libghc-clckwrks-plugin-media-dev", BinPkgName "haskell-clckwrks-plugin-media-utils"), (BinPkgName "libghc-clckwrks-plugin-bugs-dev", BinPkgName "haskell-clckwrks-plugin-bugs-utils"), (BinPkgName "libghc-clckwrks-dev", BinPkgName "haskell-clckwrks-utils")]) serverNames theSite :: BinPkgName -> D.Site theSite deb = D.Site { D.domain = hostname' , D.serverAdmin = "logic@seereason.com" , D.server = theServer deb } theServer :: BinPkgName -> D.Server theServer deb = D.Server { D.hostname = case deb of BinPkgName "clckwrks-dot-com-production" -> hostname' _ -> hostname' , D.port = portNum deb , D.headerMessage = "Generated by clckwrks-dot-com/Setup.hs" , D.retry = "60" , D.serverFlags = [ "--http-port", show (portNum deb) , "--hide-port" , "--hostname", hostname' , "--top", databaseDirectory deb , "--enable-analytics" , "--jquery-path", "/usr/share/javascript/jquery/" , "--jqueryui-path", "/usr/share/javascript/jquery-ui/" , "--jstree-path", jstreePath , "--json2-path",json2Path ] , D.installFile = D.InstallFile { D.execName = "clckwrks-dot-com-server" , D.destName = ppShow deb , D.sourceDir = Nothing , D.destDir = Nothing } } hostname' = "clckwrks.com" portNum :: BinPkgName -> Int portNum (BinPkgName deb) = case deb of "clckwrks-dot-com-production" -> 9029 "clckwrks-dot-com-staging" -> 9038 "clckwrks-dot-com-development" -> 9039 _ -> error $ "Unexpected package name: " ++ deb jstreePath = "/usr/share/clckwrks-0.13.2/jstree" json2Path = "/usr/share/clckwrks-0.13.2/json2" anyrel :: BinPkgName -> Relation anyrel b = Rel b Nothing Nothing test5 :: String -> Test test5 label = TestLabel label $ TestCase (do let inTop = "test-data/creativeprompts/input" outTop = "test-data/creativeprompts/output" atoms <- withCurrentDirectory inTop testAtoms old <- withCurrentDirectory outTop $ newFlags >>= execDebianT inputDebianization . D.makeDebInfo 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 (view debInfo new) assertEqual label [] diff) where customize old level standards = do (A.debInfo . D.utilsPackageNameBase) .= Just "creativeprompts-data" newDebianization' level standards (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) %= 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) .= 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) .= Just (intercalate "\n" [ "creativeprompts.com data files" , " Static data files for creativeprompts.com"]) (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) .= 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) .= Native3 theSite :: BinPkgName -> D.Site theSite deb = D.Site { D.domain = hostname' , D.serverAdmin = "logic@seereason.com" , D.server = theServer deb } theServer :: BinPkgName -> D.Server theServer deb = D.Server { D.hostname = case deb of BinPkgName "clckwrks-dot-com-production" -> hostname' _ -> hostname' , D.port = portNum deb , D.headerMessage = "Generated by creativeprompts-dot-com/debian/Debianize.hs" , D.retry = "60" , D.serverFlags = [ "--http-port", show (portNum deb) , "--hide-port" , "--hostname", hostname' , "--top", databaseDirectory deb , "--enable-analytics" , "--jquery-path", "/usr/share/javascript/jquery/" , "--jqueryui-path", "/usr/share/javascript/jquery-ui/" , "--jstree-path", jstreePath , "--json2-path",json2Path ] , D.installFile = D.InstallFile { D.execName = "creativeprompts-server" , D.destName = ppShow deb , D.sourceDir = Nothing , D.destDir = Nothing } } hostname' = "creativeprompts.com" portNum :: BinPkgName -> Int portNum (BinPkgName deb) = case deb of "creativeprompts-production" -> 9022 "creativeprompts-staging" -> 9033 "creativeprompts-development" -> 9034 _ -> error $ "Unexpected package name: " ++ deb jstreePath = "/usr/share/clckwrks-0.13.2/jstree" json2Path = "/usr/share/clckwrks-0.13.2/json2" test6 :: String -> Test test6 label = TestLabel label $ TestCase (do result <- readProcessWithExitCode "runhaskell" ["--ghc-arg=-package-db=dist/package.conf.inplace", "test-data/artvaluereport2/input/debian/Debianize.hs", "--dry-run"] "" assertEqual label (ExitSuccess, "", "") result) test7 :: String -> Test 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):\n No changes\n\n", "") new) test8 :: String -> Test test8 label = TestLabel label $ 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 = view D.changelog old new <- withCurrentDirectory inTop $ newFlags >>= newCabalInfo >>= execCabalT (debianize (defaultAtoms >> customize log)) 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) .= Native3 (debInfo . D.changelog) .= Just log newDebianization' (Just 9) (Just (StandardsVersion 3 9 6 Nothing)) test9 :: String -> Test test9 label = TestLabel label $ 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 : _)) = view (debInfo . D.changelog) new old <- withCurrentDirectory outTop $ newFlags >>= execDebianT (inputDebianization >> copyChangelogDate (logDate entry)) . D.makeDebInfo diff <- diffDebianizations old (view debInfo new) assertEqual label [] diff) where customize = do newDebianization' (Just 9) (Just (StandardsVersion 3 9 6 Nothing)) mapM_ (\ name -> (debInfo . D.atomSet) %= (Set.insert $ D.InstallData (BinPkgName "alex") name name)) [ "AlexTemplate" , "AlexTemplate-debug" , "AlexTemplate-ghc" , "AlexTemplate-ghc-debug" , "AlexWrapper-basic" , "AlexWrapper-basic-bytestring" , "AlexWrapper-gscan" , "AlexWrapper-monad" , "AlexWrapper-monad-bytestring" , "AlexWrapper-monadUserState" , "AlexWrapper-monadUserState-bytestring" , "AlexWrapper-posn" , "AlexWrapper-posn-bytestring" , "AlexWrapper-strict-bytestring"] (debInfo . D.control . S.homepage) .= Just "http://www.haskell.org/alex/" (debInfo . D.sourceFormat) .= 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.control . S.buildDepends) %= (++ [[Rel (BinPkgName "alex") Nothing Nothing]]) test10 :: String -> Test test10 label = TestLabel label $ TestCase (do let inTop = "test-data/archive/input" outTop = "test-data/archive/output" old <- withCurrentDirectory outTop $ newFlags >>= execDebianT inputDebianization . D.makeDebInfo let Just (ChangeLog (entry : _)) = view D.changelog old new <- withCurrentDirectory inTop $ newFlags >>= newCabalInfo >>= execCabalT (debianize (defaultAtoms >> customize >> (liftCabal $ copyChangelogDate $ logDate entry))) diff <- diffDebianizations old (view debInfo new) assertEqual label [] diff) where customize :: CabalT IO () customize = do (A.debInfo . D.sourceFormat) .= 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) .= parseMaintainer "David Fox " (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.atomSet) %= (Set.insert $ D.InstallCabalExec (BinPkgName "seereason-darcs-backups") "seereason-darcs-backups" "/etc/cron.hourly") copyChangelogDate :: Monad m => String -> DebianT m () copyChangelogDate date = D.changelog %= (\ (Just (ChangeLog (entry : older))) -> Just (ChangeLog (entry {logDate = date} : older))) data Change k a = Created k a | Deleted k a | Modified k a a | Unchanged k a deriving (Eq, Show) diffMaps :: (Ord k, Eq a, Show k, Show a) => Map.Map k a -> Map.Map k a -> [Change k a] diffMaps old new = Map.elems (intersectionWithKey combine1 old new) ++ map (uncurry Deleted) (Map.toList (differenceWithKey combine2 old new)) ++ map (uncurry Created) (Map.toList (differenceWithKey combine2 new old)) where combine1 k a b = if a == b then Unchanged k a else Modified k a b combine2 _ _ _ = Nothing diffDebianizations :: D.DebInfo -> D.DebInfo -> IO String -- [Change FilePath T.Text] diffDebianizations old new = do old' <- evalDebianT (sortBinaryDebs >> debianizationFileMap) old new' <- evalDebianT (sortBinaryDebs >> debianizationFileMap) new return $ show $ mconcat $ map prettyChange $ filter (not . isUnchanged) $ diffMaps old' new' where isUnchanged (Unchanged _ _) = True isUnchanged _ = False prettyChange :: Change FilePath Text -> Doc prettyChange (Unchanged p _) = text "Unchanged: " <> pPrint p <> text "\n" prettyChange (Deleted p _) = text "Deleted: " <> pPrint p <> text "\n" prettyChange (Created p b) = text "Created: " <> pPrint p <> text "\n" <> prettyContextDiff (text ("old" p)) (text ("new" p)) (text . unpack) -- We use split here instead of lines so we can -- detect whether the file has a final newline -- character. (getContextDiff 2 mempty (split (== '\n') b)) prettyChange (Modified p a b) = text "Modified: " <> pPrint p <> text "\n" <> prettyContextDiff (text ("old" p)) (text ("new" p)) (text . unpack) (getContextDiff 2 (split (== '\n') a) (split (== '\n') b)) sortBinaryDebs :: DebianT IO () sortBinaryDebs = (D.control . S.binaryPackages) %= sortBy (compare `on` view B.package) main :: IO () main = runTestTT tests >>= putStrLn . show cabal-debian-4.31/cabal-debian.cabal0000644000000000000000000002665412565162075015405 0ustar0000000000000000Name: cabal-debian Version: 4.31 Copyright: Copyright (c) 2007-2014, David Fox, Jeremy Shaw License: BSD3 License-File: LICENSE Author: David Fox Category: Debian, Distribution, System Maintainer: David Fox Homepage: https://github.com/ddssff/cabal-debian Build-Type: Simple Synopsis: Create a Debianization for a Cabal package Description: This package supports the generation of a package Debianization (i.e. the files in the @debian@ subdirectory) for a cabal package, either through a library API or using the cabal-debian executable. For documentation of the executable, run @cabal-debian --help@, for documentation of the library API follow the link to the @Debian.Debianize@ module below. Cabal-Version: >= 1.8 Extra-Source-Files: changelog debian/changelog debian/Debianize.hs test-data/creativeprompts/input/debian/changelog test-data/creativeprompts/input/debian/copyright test-data/creativeprompts/input/creativeprompts.cabal test-data/creativeprompts/output/debian/creativeprompts-development.init test-data/creativeprompts/output/debian/creativeprompts-development.logrotate test-data/creativeprompts/output/debian/watch test-data/creativeprompts/output/debian/creativeprompts-production.logrotate test-data/creativeprompts/output/debian/creativeprompts-production.install test-data/creativeprompts/output/debian/cabalInstall/a1cb9e4b5241944a3da44e00220b5c31/creativeprompts.com test-data/creativeprompts/output/debian/creativeprompts-production.links test-data/creativeprompts/output/debian/changelog test-data/creativeprompts/output/debian/creativeprompts-production.postinst test-data/creativeprompts/output/debian/creativeprompts-backups.install test-data/creativeprompts/output/debian/creativeprompts-development.postinst test-data/creativeprompts/output/debian/creativeprompts-backups.postinst test-data/creativeprompts/output/debian/creativeprompts-production.dirs test-data/creativeprompts/output/debian/rules test-data/creativeprompts/output/debian/compat test-data/creativeprompts/output/debian/source/format test-data/creativeprompts/output/debian/control test-data/creativeprompts/output/debian/creativeprompts-data.install test-data/creativeprompts/output/debian/creativeprompts-production.init test-data/creativeprompts/output/debian/copyright test-data/clckwrks-dot-com/input/debian/changelog test-data/clckwrks-dot-com/input/debian/Debianize.hs test-data/clckwrks-dot-com/input/LICENSE test-data/clckwrks-dot-com/input/clckwrks-dot-com.cabal test-data/clckwrks-dot-com/output/debian/clckwrks-dot-com-production.postinst test-data/clckwrks-dot-com/output/debian/watch test-data/clckwrks-dot-com/output/debian/cabalInstall/6cb4323c6b76525f567919adaf912663/clckwrks.com test-data/clckwrks-dot-com/output/debian/changelog test-data/clckwrks-dot-com/output/debian/clckwrks-dot-com-production.links test-data/clckwrks-dot-com/output/debian/clckwrks-dot-com-backups.postinst test-data/clckwrks-dot-com/output/debian/clckwrks-dot-com-production.logrotate test-data/clckwrks-dot-com/output/debian/clckwrks-dot-com-backups.install test-data/clckwrks-dot-com/output/debian/clckwrks-dot-com-production.install test-data/clckwrks-dot-com/output/debian/clckwrks-dot-com-production.init test-data/clckwrks-dot-com/output/debian/Debianize.hs test-data/clckwrks-dot-com/output/debian/rules test-data/clckwrks-dot-com/output/debian/compat test-data/clckwrks-dot-com/output/debian/source/format test-data/clckwrks-dot-com/output/debian/control test-data/clckwrks-dot-com/output/debian/copyright test-data/clckwrks-dot-com/output/debian/clckwrks-dot-com-production.dirs test-data/haskell-devscripts/debian/manpages test-data/haskell-devscripts/debian/changelog test-data/haskell-devscripts/debian/install test-data/haskell-devscripts/debian/rules test-data/haskell-devscripts/debian/compat test-data/haskell-devscripts/debian/dirs test-data/haskell-devscripts/debian/source/format test-data/haskell-devscripts/debian/control test-data/haskell-devscripts/debian/copyright test-data/haskell-devscripts/debian/docs test-data/alex/input/LICENSE test-data/alex/input/alex.cabal test-data/alex/output/debian/watch test-data/alex/output/debian/alex.install test-data/alex/output/debian/changelog test-data/alex/output/debian/rules test-data/alex/output/debian/compat test-data/alex/output/debian/source/format test-data/alex/output/debian/control test-data/alex/output/debian/copyright test-data/artvaluereport-data/input/debian/changelog test-data/artvaluereport-data/input/artvaluereport-data.cabal test-data/artvaluereport-data/input/Debianize.hs test-data/artvaluereport-data/output/debian/watch test-data/artvaluereport-data/output/debian/extra-depends test-data/artvaluereport-data/output/debian/changelog test-data/artvaluereport-data/output/debian/Debianize.hs test-data/artvaluereport-data/output/debian/rules test-data/artvaluereport-data/output/debian/compat test-data/artvaluereport-data/output/debian/source/format test-data/artvaluereport-data/output/debian/control test-data/artvaluereport-data/output/debian/copyright test-data/archive/input/debian/changelog test-data/archive/input/debian/copyright test-data/archive/input/seereason-darcs-backups.cabal test-data/archive/output/debian/watch test-data/archive/output/debian/changelog test-data/archive/output/debian/rules test-data/archive/output/debian/compat test-data/archive/output/debian/control test-data/archive/output/debian/seereason-darcs-backups.install test-data/archive/output/debian/copyright test-data/artvaluereport2/input/artvaluereport2.cabal test-data/artvaluereport2/input/debian/changelog test-data/artvaluereport2/input/debian/Debianize.hs test-data/artvaluereport2/output/debian/artvaluereport2-development.init test-data/artvaluereport2/output/debian/artvaluereport2-staging.postinst test-data/artvaluereport2/output/debian/artvaluereport2-production.postinst test-data/artvaluereport2/output/debian/watch test-data/artvaluereport2/output/debian/cabalInstall/7e4b5d8641f6fae99e9ae9b2d8893bc7/my.appraisalreportonline.com test-data/artvaluereport2/output/debian/artvaluereport2-staging.install test-data/artvaluereport2/output/debian/artvaluereport2-staging.init test-data/artvaluereport2/output/debian/artvaluereport2-production.install test-data/artvaluereport2/output/debian/changelog test-data/artvaluereport2/output/debian/artvaluereport2-production.logrotate test-data/artvaluereport2/output/debian/artvaluereport2-production.links test-data/artvaluereport2/output/debian/artvaluereport2-development.logrotate test-data/artvaluereport2/output/debian/artvaluereport2-backups.postinst test-data/artvaluereport2/output/debian/artvaluereport2-development.install test-data/artvaluereport2/output/debian/artvaluereport2-development.postinst test-data/artvaluereport2/output/debian/artvaluereport2-staging.logrotate test-data/artvaluereport2/output/debian/artvaluereport2-production.init test-data/artvaluereport2/output/debian/artvaluereport2-production.dirs test-data/artvaluereport2/output/debian/rules test-data/artvaluereport2/output/debian/compat test-data/artvaluereport2/output/debian/appraisalscope.install test-data/artvaluereport2/output/debian/control test-data/artvaluereport2/output/debian/artvaluereport2-backups.install test-data/artvaluereport2/output/debian/copyright Flag tests Description: enable the unit test executable (disabled by default because it has a lot of wacky dependencies.) Default: False Manual: True flag local-debian Description: Link directly to the source of the debian library Default: False Manual: True flag pretty-112 Description: prettyclass was merged into pretty-1.1.2 Default: True Source-Repository head type: git location: https://github.com/ddssff/cabal-debian Library Hs-Source-Dirs: src GHC-Options: -Wall -O2 Build-Depends: base < 5, bifunctors, Cabal >= 1.18, containers, data-default, deepseq, Diff >= 0.3.1, directory, exceptions, filepath, hsemail, HUnit, lens, memoize >= 0.7, mtl, network-uri, newtype-generics >= 0.4, parsec >= 3, process, pureMD5, regex-tdfa, set-extra, syb, text, unix, Unixutils >= 1.53, utf8-string, optparse-applicative == 0.11.*, ansi-wl-pprint == 0.6.* Exposed-Modules: Data.Maybe.Extended Debian.GHC Debian.Policy Distribution.Version.Invert Debian.Debianize Debian.Debianize.BasicInfo Debian.Debianize.BinaryDebDescription Debian.Debianize.BuildDependencies Debian.Debianize.Bundled Debian.Debianize.CabalInfo Debian.Debianize.Changelog Debian.Debianize.CopyrightDescription Debian.Debianize.DebianName Debian.Debianize.DebInfo Debian.Debianize.Details Debian.Debianize.Files Debian.Debianize.Finalize Debian.Debianize.Goodies Debian.Debianize.InputCabal Debian.Debianize.InputDebian Debian.Debianize.Interspersed Debian.Debianize.Monad Debian.Debianize.Optparse Debian.Debianize.Output Debian.Debianize.Prelude Debian.Debianize.SourceDebDescription Debian.Debianize.VersionSplits Paths_cabal_debian Other-Modules: Debian.Orphans if flag(pretty-112) Build-Depends: pretty >= 1.1.2 else Build-Depends: pretty < 1.1.2, prettyclass if flag(local-debian) Hs-Source-Dirs: debian-haskell Build-Depends: bytestring, bzlib, exceptions, HaXml, ListLike, network, network-uri, old-locale, process-extras, regex-compat, template-haskell, time, zlib Exposed-Modules: Debian.Apt.Dependencies, Debian.Apt.Index, Debian.Apt.Methods, Debian.Apt.Package, Debian.Arch, Debian.Changes, Debian.Control, Debian.Control.Common, Debian.Control.ByteString, Debian.Control.Policy, Debian.Control.String, Debian.Control.Text, Debian.Deb, Debian.Extra.Files, Debian.GenBuildDeps, Debian.Loc, Debian.Pretty, Debian.Relation, Debian.Relation.ByteString, Debian.Relation.Common, Debian.Relation.String, Debian.Relation.Text, Debian.Release, Debian.Sources, Debian.Version, Debian.Version.ByteString, Debian.Version.Common, Debian.Version.String, Debian.Version.Text, Debian.Report, Debian.Time, Debian.URI, Debian.UTF8, Debian.Util.FakeChanges Other-Modules: Debian.Version.Internal else Build-depends: debian >= 3.87 Executable cabal-debian Hs-Source-Dirs: . Main-is: CabalDebian.hs ghc-options: -threaded -Wall -O2 Build-Depends: base, cabal-debian, Cabal >= 1.18, lens, mtl, pretty, Unixutils >= 1.53 if flag(pretty-112) Build-Depends: pretty >= 1.1.2 else Build-Depends: pretty < 1.1.2, prettyclass if !flag(local-debian) Build-Depends: debian >= 3.87 Test-Suite cabal-debian-tests Type: exitcode-stdio-1.0 Hs-Source-Dirs: . Main-is: Tests.hs ghc-options: -threaded -Wall -O2 Build-Depends: base, cabal-debian, Cabal >= 1.18, containers, Diff >= 0.3.1, filepath, hsemail, HUnit, lens, process, text if flag(pretty-112) Build-Depends: pretty >= 1.1.2 else Build-Depends: pretty < 1.1.2, prettyclass if !flag(local-debian) Build-Depends: debian >= 3.87 cabal-debian-4.31/changelog0000644000000000000000000012653312565162075014006 0ustar0000000000000000haskell-cabal-debian (4.30.2) unstable; urgency=low * have runDebianizeScript look for source in src/ as well as ./ -- David Fox Sat, 08 Aug 2015 08:04:02 -0700 haskell-cabal-debian (4.30.1) unstable; urgency=low * Make sure apache configuration files end with .conf -- David Fox Mon, 29 Jun 2015 10:27:47 -0700 haskell-cabal-debian (4.30) unstable; urgency=low * Remove mechanism to pass arguments via the CABALDEBIAN environment variable. * Make compareDebianization a pure function. * Remove MonadIO superclass from some functions -- David Fox Thu, 18 Jun 2015 09:12:59 -0700 haskell-cabal-debian (4.29.3) unstable; urgency=low * Fix escaping of wildcard characters that are not meaningful in cabal (i.e. square brackets) * Fix generation of argument list when running an external debian/Debianization.hs script (the whole thing was being repeated.) * Make sure the enable tests and run tests options are handled correctly (not sure they were wrong, but pretty sure they're now right.) * Export Dmitry's performDebianization function instead of debianize in Debian.Debianize. -- David Fox Sat, 13 Jun 2015 05:24:03 -0700 haskell-cabal-debian (4.29) unstable; urgency=low * Restore the --epoch-map, --cabal-flag, --ghcjs, and --buildenvdir options * Export parseProgramArguments' for parsing internally constructed argument lists. -- David Fox Mon, 08 Jun 2015 06:37:25 -0700 haskell-cabal-debian (4.28) unstable; urgency=low * New command line parsing code from Dmitry Bogatov * Drop support for old package old package formats * Bug fixes and typos, API simplification, more -- David Fox Wed, 13 May 2015 06:49:04 -0700 haskell-cabal-debian (4.27.2) unstable; urgency=low * Change to the contents of the init.d file created for server packages. In Debian.Debianize.Goodies.serverAtoms, insert a line into the init.d script to set the datadir environment variable to /usr/share/cabalname before startup. -- David Fox Wed, 22 Apr 2015 10:25:52 -0700 haskell-cabal-debian (4.27.1) unstable; urgency=low * Fix spurious "Just" in debian/copyright file. -- David Fox Tue, 21 Apr 2015 07:01:35 -0700 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 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 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 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 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 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 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 for official. * Straighten out the test suite options: --no-tests, --no-run-tests -- David Fox Mon, 23 Mar 2015 11:31:14 -0700 haskell-cabal-debian (4.24.5) unstable; urgency=low * Patch from Dmitry Bogatov for filling in debian/copyright fields * Patch from Dmitry Bogatov for debhelper and haskell-devscripts build deps * Patch from Dmitry Bogatov for default changelog message * Add a --no-run-tests flag to control the nocheck option * Compatibility with different GHC versions -- David Fox Sat, 21 Mar 2015 10:14:48 -0700 haskell-cabal-debian (4.24.3) unstable; urgency=low * Always include the test suite build dependencies in debian/control, even if the testEnabled flag is set to False (at the moment it seems as if it always is.) -- David Fox Mon, 02 Mar 2015 17:33:52 -0800 haskell-cabal-debian (4.24.2) unstable; urgency=low * Distinguish between the place we find the data files (dataTop) and the place we put then (dataDest) * Add a case for the ISC license -- David Fox Sun, 22 Feb 2015 15:09:56 -0800 haskell-cabal-debian (4.24.1) unstable; urgency=low * Don't assign the name "cabal-ghcjs" to newer Cabal library versions -- David Fox Sun, 22 Feb 2015 06:08:28 -0800 haskell-cabal-debian (4.24) unstable; urgency=low * Convert from old data-lens package to lens. * Implement --allow-debian-self-build-deps -- David Fox Sat, 14 Feb 2015 06:15:01 -0800 haskell-cabal-debian (4.23.1) unstable; urgency=low * ifdefs for Cabal-1.18, 1.20, and 1.22, ghc-7.6, and 7.8. -- David Fox Sun, 08 Feb 2015 23:21:07 -0800 haskell-cabal-debian (4.23) unstable; urgency=low * Add DEB_ENABLE_TESTS = yes to rules file when appropriate * Add test suite build dependencies when appropriate * Add --no-test-suite option * Add --allow-debian-self-build-deps * Filter out self dependencies in the debian package space, not the cabal package space. * Fix generation of machine readable debian/copyright files * Use the homepage value found in the cabal file * Add travis build file -- David Fox Fri, 06 Feb 2015 06:25:08 -0800 haskell-cabal-debian (4.22) unstable; urgency=low * Big module reorganization for more type safety. -- David Fox Tue, 03 Feb 2015 13:22:29 -0800 haskell-cabal-debian (4.21.1) unstable; urgency=low * Fix --buildenvdir command line option. * Add an option for cabal flags -- David Fox Fri, 30 Jan 2015 13:46:08 -0800 haskell-cabal-debian (4.21) unstable; urgency=low * Split the enormous Atoms record into three layers - the innermost is Flags, which contains information obtained from the command line arguments. Flags is also the argument to the inputCabalization function, which inputs a Cabal PackageDescription. The Flags record is embedded in a DebInfo, which holds information related to the Debianization only. The DebInfo and the PackageDescription are used to build the old Atoms record. DebInfo is the state value of the DebianT monad, while Atoms is the state value of the CabalT monad. The point of all this is to ensure that a PackageDescription exists before we start converting the Cabalization to a Debianization. -- David Fox Thu, 29 Jan 2015 12:29:52 -0800 haskell-cabal-debian (4.20.2) unstable; urgency=low * Do not lowercase the package name when constructing the data file destination directory (/usr/share/). -- David Fox Fri, 16 Jan 2015 05:45:23 -0800 haskell-cabal-debian (4.20.1) unstable; urgency=low * Fix a bug in the computation of the debian maintainer field * Improve rules file generation -- David Fox Wed, 14 Jan 2015 14:38:56 -0800 haskell-cabal-debian (4.20) unstable; urgency=low * Add a --source-section option * Fix handling of debian maintainer and debian uploaders * Improve formatting of debian/rules file * Rename function debianization -> debianize * Rename function finalizeDebianization' -> finalizeDebianization * Rename function getDebianMaintainer -> getCurrentDebianUser -- David Fox Fri, 09 Jan 2015 11:49:04 -0800 haskell-cabal-debian (4.19.3) unstable; urgency=low * Fix issue #23, so that if you run 'cabal-debian' and then 'cabal-debian --compare' it says there are no differences. * Fix issue #16 - set revision if format is Quilt3. -- David Fox Thu, 08 Jan 2015 05:20:32 -0800 haskell-cabal-debian (4.19.2) unstable; urgency=low * Use canonical to put the debianization in a standard form before trying to compare existing and generated. * Fix bug where cabal-debian program processed the command line options twice. * Avoid using paths that point to ../ in the cabal file (even if disabled by a flag), it causes the package to be rejected by hackage. -- David Fox Wed, 07 Jan 2015 13:26:33 -0800 haskell-cabal-debian (4.19.1) unstable; urgency=low * Support Cabal-1.22 * Test whether apt-file is installed (from creichert) * Conditional compilation for new symbols MPL and BSD2 (from creichert) -- David Fox Wed, 07 Jan 2015 12:56:00 -0800 haskell-cabal-debian (4.19) unstable; urgency=low * Add remapCabal function here from a private package * Remove debianVersionSplits, which has long been replaced by debianDefaultAtoms. -- David Fox Mon, 08 Dec 2014 10:07:06 -0800 haskell-cabal-debian (4.18) unstable; urgency=low * Add types to support machine readable copyright files. * Add --debian-base-name option and overrideDebianBaseName lens. * Add --omit-prof-version-deps option flag, have --official imply it -- David Fox Thu, 27 Nov 2014 07:11:35 -0800 haskell-cabal-debian (4.17.5) unstable; urgency=low * Use the prettyclass package and the PP wrappers in the latest debian package to do pretty printing. * Change default priority to extra * Use the new watch file suggested by nomeata * Use the control file template suggested in issue #3 -- David Fox Mon, 15 Sep 2014 13:28:36 -0700 haskell-cabal-debian (4.17.4) unstable; urgency=low * Add missing ifdefs to hide the GHCJS constructor when ghcjs-support flag is False. * Require Cabal < 1.21 when ghcjs-support flag is False. -- David Fox Tue, 02 Sep 2014 09:06:20 -0700 haskell-cabal-debian (4.17.3) unstable; urgency=low * Moved source repository to github.com. -- David Fox Fri, 29 Aug 2014 13:55:26 -0700 haskell-cabal-debian (4.17.2) unstable; urgency=low * Fix formatting of the generated debian/*.install files. -- David Fox Tue, 19 Aug 2014 16:04:27 -0700 haskell-cabal-debian (4.17.1) unstable; urgency=low * Fix install of ghcjs executables - there was an extra subdir. * Don't append -ghcjs to default package name. -- David Fox Tue, 19 Aug 2014 10:15:46 -0700 haskell-cabal-debian (4.17) unstable; urgency=low * Fix bug in architecture dependent build dependency generation - it was getting the indep dependencies as well. * Support GHCJS executable packages, which are directories with the extension .jsexe. -- David Fox Mon, 18 Aug 2014 17:31:35 -0700 haskell-cabal-debian (4.16.1) unstable; urgency=low * Support for packaging libraries produced by the GHCJS compiler. * Generate debianizations that include libraries for multiple compiler flavors (not yet suppored in haskell-devscripts and/or Cabal.) * Put a DEB_DEFAULT_COMPILER assignment in debian/rules if we can infer it from the command line options. -- David Fox Sat, 16 Aug 2014 07:56:50 -0700 haskell-cabal-debian (4.15.2) unstable; urgency=low * Lowercase the strings in the extraLibs argument of allBuildDepends before wrapping them in BinPkgName. Those types, which come from the debian package, should be opaque and do this whenever a BinPkgName (or SrcPkgName) is created, because upper case is never ok in Debian source or binary package names. In the meantime I will make this requested change. Thanks to Sven Bartscher for pointing this out. -- David Fox Tue, 12 Aug 2014 07:47:17 -0700 haskell-cabal-debian (4.15.1) unstable; urgency=low * Add Data and Typeable instances. -- David Fox Thu, 17 Jul 2014 11:22:17 -0700 haskell-cabal-debian (4.15) unstable; urgency=low * Don't hardcode the compiler name in makefile targets. -- David Fox Sat, 12 Jul 2014 12:15:10 -0700 haskell-cabal-debian (4.14) unstable; urgency=low * Move the code to map the cabal package named "Cabal" to the debian package named "libghc-cabal-*" from the seereason defaults to the debian defaults. -- David Fox Mon, 07 Jul 2014 08:35:39 -0700 haskell-cabal-debian (4.13) unstable; urgency=low * Add a flag for ghcjs support. -- David Fox Thu, 03 Jul 2014 12:05:21 -0700 haskell-cabal-debian (4.12) unstable; urgency=low * Remove the Top type and argument - use getWorkingDirectory instead. -- David Fox Sun, 29 Jun 2014 08:11:01 -0700 haskell-cabal-debian (4.11) unstable; urgency=low * Use MonadIO instead of IO for all signatures. This is so we can more easily use cabal debian from a Shelly script. -- David Fox Sun, 29 Jun 2014 07:16:45 -0700 haskell-cabal-debian (4.10.1) unstable; urgency=low * Fix a tail exception in builtIn. -- David Fox Tue, 17 Jun 2014 07:21:22 -0700 haskell-cabal-debian (4.10) unstable; urgency=low * Rename knownVersionSplits -> debianVersionSplits and move to Debian.Debianize.Details. (Should that be renamed Debian.Debianize.Debian?) * Add HC=ghc or HC=ghcjs to header of debian/rules depending on the value of the compilerFlavor atom. -- David Fox Sat, 14 Jun 2014 10:20:01 -0700 haskell-cabal-debian (4.9) unstable; urgency=low * Generate the library package prefix, previously hard coded as libghc-, using the CompilerFlavor value, so we get libghcjs-foo-dev when using ghcjs. -- David Fox Fri, 13 Jun 2014 09:58:13 -0700 haskell-cabal-debian (4.8) unstable; urgency=low * Add a --no-hoogle flag to omit the hoogle documentation link. This link doesn't contain the package's version number, so it will conflict with other versions of the library (such as those built into ghc.) -- David Fox Tue, 10 Jun 2014 10:42:38 -0700 haskell-cabal-debian (4.7.1) unstable; urgency=low * Fix the code added in 4.7. * Add --recommends and --suggests options, similar to --depends et. al. -- David Fox Tue, 03 Jun 2014 07:14:52 -0700 haskell-cabal-debian (4.7) unstable; urgency=low * Improve the treatment of dependencies which are built into ghc. This will allow the use of newer libraries than the ones built into ghc, provided they are given deb names that are different than the one ghc specifically conflicts with. For example, a newer version of Cabal could be used if it was in the deb package libghc-cabal-ghcjs-dev. To change the debian names of libraries we need to use the mapCabal and splitCabal functions, as is done in the autobuilder-seereason module Debian.AutoBuilder.Details.Atoms. -- David Fox Mon, 02 Jun 2014 14:28:59 -0700 haskell-cabal-debian (4.6.2) unstable; urgency=low * Move a seereason specific function from here to the autobuilder-seereason package. -- David Fox Mon, 02 Jun 2014 11:03:13 -0700 haskell-cabal-debian (4.6.1) unstable; urgency=low * Don't compute the current ghc version so often. -- David Fox Fri, 30 May 2014 13:40:12 -0700 haskell-cabal-debian (4.6) unstable; urgency=low * Add a --default-package option to change haskell-packagename-utils to some other name. * Fix treatment of cabalfile Data-Dir field - it describes where the data files are in the source tree, but shouldn't affect where they will be installed. -- David Fox Thu, 29 May 2014 08:27:54 -0700 haskell-cabal-debian (4.5) unstable; urgency=low * Remove the ghcVersion field and lens. -- David Fox Mon, 05 May 2014 11:55:53 -0700 haskell-cabal-debian (4.4) unstable; urgency=low * Add the copytruncate directive to logrotate files we generate. As things were, hslogger would continue writing to the deleted log file after it was rotated. -- David Fox Sun, 30 Mar 2014 13:05:48 -0700 haskell-cabal-debian (4.3.2) unstable; urgency=low * Speed up debianization by computing the ghc version once when we enter the DebT monad rather than repeatedly. It is slow because it needs to chroot. -- David Fox Fri, 28 Mar 2014 13:03:57 -0700 haskell-cabal-debian (4.3.1) unstable; urgency=low * Safer default value for buildEnv - "/" instead of "". This is where we look for the GHC version number. -- David Fox Thu, 27 Mar 2014 06:12:28 -0700 haskell-cabal-debian (4.3) unstable; urgency=low * Make the default value for buildEnv "/", this makes it normally look at the version number of the ghc compiler installed in the root environment. -- David Fox Mon, 24 Mar 2014 06:01:49 -0700 haskell-cabal-debian (4.2) unstable; urgency=low * Get the GHC compiler version from the build environment, which now needs to be explicitly set. -- David Fox Fri, 07 Mar 2014 10:58:37 -0800 haskell-cabal-debian (4.1.1) unstable; urgency=low * Remove build dependency on ansi-wl-pprint. * Split module Debian.Debianize.BuildDependencies out of Debian.Debianize.Finalize -- David Fox Sun, 02 Feb 2014 07:37:03 -0800 haskell-cabal-debian (4.0.6) unstable; urgency=low * Ifdef out duplicate instances for Cabal-1.18.0 - thanks to Tom Nielsen. -- David Fox Tue, 28 Jan 2014 17:10:48 -0800 haskell-cabal-debian (4.0.5) unstable; urgency=low * Changes for debian-3.81 - use the pretty printer in Debian.Pretty instead of ansi-wl-pprint. -- David Fox Tue, 14 Jan 2014 05:02:59 -0800 haskell-cabal-debian (4.0.4) unstable; urgency=low * Restore the test data, the problem I had with long filenames is solved by using cabal sdist to create the tarball rather than runhaskell Setup sdist. -- David Fox Wed, 18 Dec 2013 09:37:34 -0800 haskell-cabal-debian (4.0.3) unstable; urgency=low * Include the build dependencies of the executables in the debian source deb build dependencies. -- David Fox Tue, 10 Dec 2013 14:37:20 -0800 haskell-cabal-debian (4.0.2) unstable; urgency=low * Export some lens state operators from Prelude. -- David Fox Tue, 10 Dec 2013 05:38:00 -0800 haskell-cabal-debian (4.0.1) unstable; urgency=low * Make sure the utilities package gets created even if no name has been specified for it - use the name generated in DebianNames.hs. -- David Fox Tue, 10 Dec 2013 05:10:11 -0800 haskell-cabal-debian (4.0.0) unstable; urgency=low * Massive lens overhaul -- David Fox Thu, 05 Dec 2013 12:26:31 -0800 haskell-cabal-debian (3.10.3) unstable; urgency=low * Go back to using lens interface directly * Collect debianization fact code in Facts/ -- David Fox Sun, 24 Nov 2013 10:40:02 -0800 haskell-cabal-debian (3.10.2) unstable; urgency=low * Make some signatures in Monad.hs clearer -- David Fox Wed, 20 Nov 2013 14:26:28 -0800 haskell-cabal-debian (3.10.1) unstable; urgency=low * More API changes - want need to get all the clients in sync before proceeding. -- David Fox Tue, 19 Nov 2013 11:31:16 -0800 haskell-cabal-debian (3.10) unstable; urgency=low * Add a monadic interface -- David Fox Sat, 16 Nov 2013 10:42:02 -0800 haskell-cabal-debian (3.9) unstable; urgency=low * Clean up documentation * Allow more than one utility package name, each of which will get copies of the data-files and leftover executables. * Make the --debianize option a no-op, the behavior is now the default. * Update the unit tests and build an executable to run them. * Copy debian/changelog to top directory at beginning of build so hackage will see it. -- David Fox Tue, 05 Nov 2013 11:34:48 -0800 haskell-cabal-debian (3.8.3) unstable; urgency=low * Add an ifdef for compatibility with GHC-7.4.1. -- David Fox Sun, 20 Oct 2013 15:50:47 -0700 haskell-cabal-debian (3.8.2) unstable; urgency=low * Actually, copy changelog from debian/changelog before building sdist tarball. -- David Fox Tue, 15 Oct 2013 06:42:39 -0700 haskell-cabal-debian (3.8.1) unstable; urgency=low * Move changelog top top directory so hackage will see it. -- David Fox Tue, 15 Oct 2013 06:24:25 -0700 haskell-cabal-debian (3.8) unstable; urgency=low * Downcase the package name to build the datadir name in /usr/share, this matches the paths in dist/autogen/Paths_packagename. -- David Fox Mon, 14 Oct 2013 20:48:39 -0700 haskell-cabal-debian (3.7) unstable; urgency=low * Change path to hackage tarball in watch file for hackage2. -- David Fox Fri, 04 Oct 2013 09:22:51 -0700 haskell-cabal-debian (3.6) unstable; urgency=low * Require haskell-devscripts >= 0.8.19. This version changes the value of datasubdir from /usr/share/packagename-packageversion to simply /usr/share/packagename. This could break some packaging. -- David Fox Fri, 06 Sep 2013 16:48:18 -0700 haskell-cabal-debian (3.5) unstable; urgency=low * Allow full lists of debian relations to be passed to the --build-dep argument, not just a single package name. -- David Fox Sun, 01 Sep 2013 07:08:37 -0700 haskell-cabal-debian (3.4.3) unstable; urgency=low * Fix the repository location in the cabal file. -- David Fox Sat, 31 Aug 2013 07:57:15 -0700 haskell-cabal-debian (3.4.2) unstable; urgency=low * Notify user when debhelper isn't installed. * Avoid use of partial function read -- David Fox Mon, 24 Jun 2013 13:51:51 -0700 haskell-cabal-debian (3.4.1) unstable; urgency=low * Remove call to test script in Setup.hs * Remove unused dependencies -- David Fox Mon, 10 Jun 2013 09:12:38 -0700 haskell-cabal-debian (3.4) unstable; urgency=low * Add support for modifying the Provides and Replaces fields. -- David Fox Sun, 09 Jun 2013 14:18:39 -0700 haskell-cabal-debian (3.3.2) unstable; urgency=low * Changes for debian-3.71 -- David Fox Sun, 14 Apr 2013 13:32:04 -0700 haskell-cabal-debian (3.3.1) unstable; urgency=low * Don't fail during dry run if the existing debianization has no copyright file. -- David Fox Wed, 13 Mar 2013 10:00:25 -0700 haskell-cabal-debian (3.3) unstable; urgency=low * Add Debian.Debianize.Details, with default Atoms values for Debian and SeeReason. -- David Fox Mon, 11 Mar 2013 11:44:10 -0700 haskell-cabal-debian (3.2.5) unstable; urgency=low * Add move the VersionSplits type into a module, and fix the code that splits the mapping of cabal to debian names over a version range. -- David Fox Tue, 05 Mar 2013 05:17:03 -0800 haskell-cabal-debian (3.2.4) unstable; urgency=low * Fix long standing bug in Debian.Debianize.Interspersed.foldTriples. -- David Fox Sun, 03 Mar 2013 09:45:14 -0800 haskell-cabal-debian (3.2.3) unstable; urgency=low * Clean up mapping from cabal names to debian names. -- David Fox Sat, 02 Mar 2013 07:36:16 -0800 haskell-cabal-debian (3.2.2) unstable; urgency=low * Remove unused Debian.Debianize.Generic and Triplets modules. -- David Fox Fri, 01 Mar 2013 11:14:33 -0800 haskell-cabal-debian (3.2.1) unstable; urgency=low * Do not add the options +RTS -IO -RTS to the server options, this is a security risk. Instead, server executables should built with -with-rtsopts=-IO. -- David Fox Thu, 28 Feb 2013 09:02:39 -0800 haskell-cabal-debian (3.2) unstable; urgency=low * Strip executables when installing (well, at least some. There may be more work to do here.) * Change the build dependency type from BinPkgName to Relation, so we can specify version dependencies (though as yet not or relations.) -- David Fox Tue, 26 Feb 2013 07:17:30 -0800 haskell-cabal-debian (3.1.1) unstable; urgency=low * Fix the code in the init file that checks for and sources a file in /etc/default. -- David Fox Mon, 25 Feb 2013 14:46:02 -0800 haskell-cabal-debian (3.1) unstable; urgency=low * Create a Top type to represent the top directory of a debianization * Change the signature of Debian.Debianize.debianization so it notices command line arguments and environment arguments. -- David Fox Fri, 22 Feb 2013 13:28:30 -0800 haskell-cabal-debian (3.0.7) unstable; urgency=low * Fix to copyright/license code * have the init script load /etc/default/packagename if available * Add an alternative function to showCommandForUser (called showCommand) that uses double quotes instead of single quotes so you can reference shell variables. -- David Fox Wed, 20 Feb 2013 09:29:11 -0800 haskell-cabal-debian (3.0.6) unstable; urgency=low * When packaging a web site or server, don't add code to the postinst to start a server, it gets generated by debhelper. * Add the changelog and the Debianize.hs file to extra-source-files. * Add HTTP=1 to the list of known epoch mappings. -- David Fox Thu, 14 Feb 2013 14:41:17 -0800 haskell-cabal-debian (3.0.5) unstable; urgency=low * Compatibility with ghc-7.4 -- David Fox Wed, 13 Feb 2013 10:48:19 -0800 haskell-cabal-debian (3.0.4) unstable; urgency=low * Add dependency on debian-policy, so we can compute the latest standards-version. * Documentation improvements * Test case improvements * Error message improvements -- David Fox Sun, 10 Feb 2013 11:03:55 -0800 haskell-cabal-debian (3.0.3) unstable; urgency=low * Due to a typo, the noDocumentationLibrary lens was turning off profiling rather than documentation. -- David Fox Fri, 08 Feb 2013 17:14:09 -0800 haskell-cabal-debian (3.0.2) unstable; urgency=low * Fix argument and exception handling in cabal-debian * Make Standards-Version field non-mandatory * Make sure every binary deb paragraph has a non-empty description -- David Fox Thu, 07 Feb 2013 10:03:25 -0800 haskell-cabal-debian (3.0.1) unstable; urgency=low * Don't build Debian version numbers with revision (Just ""). * Output the descriptions of the binary packages. -- David Fox Tue, 05 Feb 2013 14:48:33 -0800 haskell-cabal-debian (3.0) unstable; urgency=low * Moved the Distribution.Debian modules to Debian.Cabal and Debian.Debianize. * Refactored the debianize function for easier testing * Added test cases. * Add a Debianization type that intends to fully describe a debian package, with functions to read, build, modify, and write a Debianization. -- David Fox Wed, 26 Dec 2012 05:45:35 -0800 haskell-cabal-debian (2.6.3) unstable; urgency=low * Fix pretty printing of Relations (i.e. dependency lists.) There is an instance for printing lists in ansi-wl-pprint which prevents us from writing customized Pretty instances for type aliases like Relations, AndRelation, and OrRelation. -- David Fox Fri, 04 Jan 2013 09:30:48 -0800 haskell-cabal-debian (2.6.2) unstable; urgency=low * Fix a bug constructing the destination pathnames that was dropping files that were supposed to be installed into packages. -- David Fox Thu, 20 Dec 2012 06:49:25 -0800 haskell-cabal-debian (2.6.1) unstable; urgency=low * Remove the modifyAtoms field from the Flags record, we want to be able to create instances like Read and Show for this type. The modifyAtoms function is now passed separately to debianize. * The flags field of Server was renamed serverFlags because the newly exported Config record has a flags field. -- David Fox Wed, 19 Dec 2012 09:45:22 -0800 haskell-cabal-debian (2.5.10) unstable; urgency=low * Filter cabal self dependencies out before generating Build-Depends-Indep, just as we added code to filter them out of Build-Depends in version 2.5.7. -- David Fox Tue, 18 Dec 2012 13:23:39 -0800 haskell-cabal-debian (2.5.9) unstable; urgency=low * Always add +RTS -IO -RTS to server flags. -- David Fox Sun, 16 Dec 2012 10:40:52 -0800 haskell-cabal-debian (2.5.8) unstable; urgency=low * Add a builtin list for ghc-7.6.1. -- David Fox Sat, 15 Dec 2012 07:04:49 -0800 haskell-cabal-debian (2.5.7) unstable; urgency=low * Filter out cabal self-dependencies before building the debian dependencies. In cabal a self dependency means you need the library to build an executable, while in debian it means you need an older version installed to build the current version. -- David Fox Thu, 29 Nov 2012 08:42:30 -0800 haskell-cabal-debian (2.5.6) unstable; urgency=low * Don't add --base-uri and --http-port arguments automatically, they can be computed by calling the oldClckwrksFlags function and adding the value to the flags field. Clckwrks-0.3 no longer needs the --base-uri argument. -- David Fox Tue, 27 Nov 2012 13:34:31 -0800 haskell-cabal-debian (2.5.5) unstable; urgency=low * Have the debianize function return False if there is no debian/Debianize.hs file, but throw an exception if running it failed, so we notice bad debianization code. -- David Fox Tue, 27 Nov 2012 07:34:51 -0800 haskell-cabal-debian (2.5.4) unstable; urgency=low * Insert "SetEnv proxy-sendcl 1" line into Apache config. -- David Fox Tue, 20 Nov 2012 13:43:54 -0800 haskell-cabal-debian (2.5.3) unstable; urgency=low * Remove extra copy of binary from the executable debs * Add a sourcePackageName field to Flags, and a --source-package-name command line option. -- David Fox Sat, 17 Nov 2012 00:16:21 -0800 haskell-cabal-debian (2.5.2) unstable; urgency=low * Fix the path to where the DHInstallTo and DHInstallCabalExecTo DebAtoms put their files. -- David Fox Fri, 16 Nov 2012 18:11:45 -0800 haskell-cabal-debian (2.5.1) unstable; urgency=low * Add a destName field to Executable so we can give installed executables a different name than they had in the build. -- David Fox Fri, 16 Nov 2012 15:37:16 -0800 haskell-cabal-debian (2.5) unstable; urgency=low * Add a debName field to the Executable record, before the deb package name had to equal the executable name. -- David Fox Fri, 16 Nov 2012 12:32:39 -0800 haskell-cabal-debian (2.4.2) unstable; urgency=low * Move location of cabal install files from dist/build/install to debian/cabalInstall, the dist directory was getting wiped at bad moments. * Split the autobuilder function autobuilderDebianize into two new functions in cabal-debian: runDebianize and callDebianize. * Custom debianization code now goes in debian/Debianize.hs rather than in setup, so we can distinguish it failing from it not existing more easily. -- David Fox Thu, 15 Nov 2012 11:00:08 -0800 haskell-cabal-debian (2.4.1) unstable; urgency=low * We need to verify that debian/compat was created after running the debianize function, because ghc still exits with ExitSuccess -- David Fox Thu, 15 Nov 2012 06:34:02 -0800 haskell-cabal-debian (2.4.0) unstable; urgency=low * You can run a function in Setup.hs other than main using ghc -e, so we will use this trick to run the debianize function directly rather than running main. * Eliminate the autobuilderDebianize function. -- David Fox Thu, 15 Nov 2012 04:05:49 -0800 haskell-cabal-debian (2.3.4) unstable; urgency=low * Fix the builddir used when running the cabal-debian standalone executable - it was dist-cabal/build, so the resulting debianization had files in places where cabal didn't expect them. -- David Fox Tue, 13 Nov 2012 06:20:51 -0800 haskell-cabal-debian (2.3.3) unstable; urgency=low * Eliminate class MonadBuild and the BuildT monad. -- David Fox Sun, 11 Nov 2012 17:46:31 -0800 haskell-cabal-debian (2.3.2) unstable; urgency=low * Fix exception that was keeping changelogs from being preserved. -- David Fox Sat, 10 Nov 2012 10:07:50 -0800 haskell-cabal-debian (2.3.1) unstable; urgency=low * Fix the extension of the debhelper links files * Add a general mechanism for installing a file into a deb when we have the file's text in a String (rather than in a file.) -- David Fox Sat, 10 Nov 2012 07:35:09 -0800 haskell-cabal-debian (2.3) unstable; urgency=low * Add MonadBuild. -- David Fox Fri, 09 Nov 2012 12:21:14 -0800 haskell-cabal-debian (2.2.1) unstable; urgency=low * Add a modifyAtoms function to Flags that is applied to final list of DebAtom before writing the debianization. * Add DHApacheSite and DHInstallCabalExec atoms so atoms don't depend on the build directory * Add #DEBHELPER# and exit 0 to default web server postinst. -- David Fox Fri, 09 Nov 2012 10:25:32 -0800 haskell-cabal-debian (2.2.0) unstable; urgency=low * Append a trailing slash to the --base-uri argument passed to the server. This is required by Web.Routes.Site.runSite. -- David Fox Thu, 08 Nov 2012 04:40:08 -0800 haskell-cabal-debian (2.1.4) unstable; urgency=low * Merge the Executable and Script constructors of the Executable type * Add a destDir field to Executable to specify the destination. -- David Fox Tue, 06 Nov 2012 13:24:25 -0800 haskell-cabal-debian (2.1.3) unstable; urgency=low * Don't append a slash to the base-uri. * Construct the name of the data directory in /usr/share from the cabal package name rather than the debian source package name. * Add a --self-depend flag to include a build dependency on this library in all generated debianizations. -- David Fox Tue, 06 Nov 2012 07:07:57 -0800 haskell-cabal-debian (2.1.2) unstable; urgency=low * Output the server support files. -- David Fox Tue, 06 Nov 2012 06:37:18 -0800 haskell-cabal-debian (2.1.1) unstable; urgency=low * Restore code that checks for version number match when validating a debianization. The autobuilder can now pass the version number to cabal-debian, so it should match. -- David Fox Mon, 05 Nov 2012 17:42:32 -0800 haskell-cabal-debian (2.1.0) unstable; urgency=low * Enable processing of Script, Server and WebSite executables. -- David Fox Mon, 05 Nov 2012 12:45:42 -0800 haskell-cabal-debian (2.0.9) unstable; urgency=low * Add a Library section, export all the modules. -- David Fox Mon, 05 Nov 2012 06:41:25 -0800 haskell-cabal-debian (2.0.8) unstable; urgency=low * Bypass abandoned versions. -- David Fox Sat, 03 Nov 2012 06:13:27 -0700 haskell-cabal-debian (1.26) unstable; urgency=low * Don't try to update the existing debianization, except for the changelog where we retain entries that look older than the one we generate. * Use .install files instead of adding rules to debian/rules * Add --depends and --conflicts options -- David Fox Thu, 25 Oct 2012 12:03:49 -0700 haskell-cabal-debian (1.25) unstable; urgency=low * If the --disable-haddock flag is given omit the doc package from the control file. * The tarball that was uploaded to Hackage as version 1.24 had a (buggy) change which was not pushed to darcs. This resolves that confusion. -- David Fox Sat, 16 Jun 2012 14:42:12 -0700 haskell-cabal-debian (1.24) unstable; urgency=low * No wonder it doesn't build on hackage - none of the source modules were shipped. -- David Fox Thu, 14 Jun 2012 08:19:19 -0700 haskell-cabal-debian (1.23) unstable; urgency=low * Add a --quilt option to switch from native to quilt format. Without this option the file debian/source/format will contain '3.0 (native)', with it '3.0 (quilt)'. -- David Fox Fri, 01 Jun 2012 05:53:36 -0700 haskell-cabal-debian (1.22) unstable; urgency=low * Bump version to make sure all changes are uploaded. -- David Fox Wed, 23 May 2012 19:54:17 -0700 haskell-cabal-debian (1.21) unstable; urgency=low * fix conversion of wildcards into intersected ranges -- David Fox Wed, 23 May 2012 19:51:34 -0700 haskell-cabal-debian (1.20) unstable; urgency=low * Fix generation of debian library dependencies from the Extra-Libraries field of the cabal file. -- David Fox Wed, 23 May 2012 19:50:39 -0700 haskell-cabal-debian (1.19) unstable; urgency=low * Handle cabal equals dependencies. -- David Fox Tue, 20 Mar 2012 14:34:58 -0700 haskell-cabal-debian (1.18) unstable; urgency=low * High level of confidence this time. Interesting new Interspersed class, and an implementation of invertVersionRanges which should be forwarded to the Cabal folks. * Removes dependency on logic-classes -- David Fox Tue, 20 Mar 2012 08:17:25 -0700 haskell-cabal-debian (1.17) unstable; urgency=low * Restore code to downcase cabal package name before using it as the base of the debian package name. -- David Fox Sun, 18 Mar 2012 15:32:04 -0700 haskell-cabal-debian (1.16) unstable; urgency=low * Remove code that implements a special case for the debian name of the haskell-src-exts package. -- David Fox Sun, 18 Mar 2012 14:11:21 -0700 haskell-cabal-debian (1.15) unstable; urgency=low * Yet another stab at fixing the code for converting cabal dependencies to debian dependencies, with support for splitting version ranges of cabal files among different debian packages. -- David Fox Fri, 16 Mar 2012 17:59:28 -0700 haskell-cabal-debian (1.14) unstable; urgency=low * Don't try to strip data files * Use permissions 644 for data files, not 755. -- David Fox Wed, 07 Mar 2012 14:46:04 -0800 haskell-cabal-debian (1.13) unstable; urgency=low * Append the version number when constructing the directory for data files. -- David Fox Wed, 07 Mar 2012 08:56:39 -0800 haskell-cabal-debian (1.12) unstable; urgency=low * Include any files listed in the Data-Files field of the cabal file in the utils package. -- David Fox Tue, 06 Mar 2012 11:31:47 -0800 haskell-cabal-debian (1.11) unstable; urgency=low * Replace --epoch flag with --epoch-map, so we can specify epoch numbers for both the package being built and for dependency packages. -- David Fox Thu, 09 Feb 2012 07:01:19 -0800 haskell-cabal-debian (1.10) unstable; urgency=low * Add bundled package list for ghc 7.4.1. -- David Fox Sat, 04 Feb 2012 14:44:33 -0800 haskell-cabal-debian (1.9) unstable; urgency=low * Add --dep-map flag to allow mapping of cabal package names to the base of a debian package name. This modifies the name to which the prefix "lib" and the suffix "-dev" are added. * Fix dependency generation bug introduced in 1.8. -- David Fox Mon, 23 Jan 2012 14:13:05 -0800 haskell-cabal-debian (1.8) unstable; urgency=low * Add a --dev-dep flag to make one or more packages install dependencies of the dev package. -- David Fox Mon, 23 Jan 2012 05:00:46 -0800 haskell-cabal-debian (1.7) unstable; urgency=low * Add info about ghc 7.4.0 pre-release. -- David Fox Wed, 11 Jan 2012 09:57:45 -0800 haskell-cabal-debian (1.6) unstable; urgency=low * Don't omit dependencies built into ghc, they should be satisfied by the Provides in the compiler if they are not available in the repository. However, we do need to make ghc an alterantive to any versioned dependencies that are bundled with the compiler, since the built in dependencies are virtual packages and thus unversioned. -- David Fox Wed, 07 Dec 2011 06:10:17 -0800 haskell-cabal-debian (1.5) unstable; urgency=low * Fix the generation of build dependency version ranges by using an intermediate version range type. * If the version range for the cabal file touches two different debian package, don't try to write build dependencies that allow either one, it can't really be done. Just give the allowable versions of the newer package (e.g. libghc-parsec3-dev rather than libghc-parsec2-dev.) -- David Fox Sun, 04 Dec 2011 05:59:25 -0800 haskell-cabal-debian (1.4) unstable; urgency=low * Add a --revision flag which appends a (perhaps empty) string cabal version number to get the debian version number. Without this flag the string "-1~hackage1" is appended. * Make it an error to specify a debian version via --deb-version that is older than the current cabal version. -- David Fox Sun, 20 Nov 2011 06:45:33 -0800 haskell-cabal-debian (1.3) unstable; urgency=low * Fix error message when compiler version is not in bundled package list. * Add bundled package list for compiler 7.0.4 (same as 7.0.3.) -- David Fox Sat, 08 Oct 2011 07:58:19 -0700 haskell-cabal-debian (1.2) unstable; urgency=low * When computing the debian name from a package's cabal name, if we have no particular version number we are comparing to, use the name from the version split that corresponds to newer version numbers. * Add code to make the cabal package haskell-src-exts map to the debian packages libghc-src-exts-dev etc. Normally it would map to libghc-haskell-src-exts-dev. -- David Fox Thu, 06 Oct 2011 09:27:02 -0700 haskell-cabal-debian (1.1) unstable; urgency=low * Use propositional logic package to compute normal form for dependencies * Make sure to correct format of cabal package synopsis before using as debian package description. -- David Fox Fri, 30 Sep 2011 06:16:34 -0700 haskell-cabal-debian (1.0) unstable; urgency=low * Debianization generated by cabal-debian -- David Fox Sun, 18 Sep 2011 06:40:21 -0700 cabal-debian-4.31/LICENSE0000644000000000000000000000310612565162075013127 0ustar0000000000000000The packageing was adjusted to Debian conventions by Joachim Breitner on Sat, 01 May 2010 21:16:18 +0200, and is licenced under the same terms as the package itself. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * The names of contributors may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. cabal-debian-4.31/Setup.hs0000644000000000000000000000413712565162075013563 0ustar0000000000000000#!/usr/bin/runhaskell import Control.Exception (try) import Control.Monad (when) import Distribution.Simple import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(buildDir)) import Distribution.Simple.Program import GHC.IO.Exception (IOException(ioe_type), IOErrorType(InvalidArgument, NoSuchThing)) import System.Posix.Files (readSymbolicLink, createSymbolicLink) import System.Process import System.Directory import System.Exit main = ensureSymbolicLink "../debian-haskell" "debian-haskell" >> defaultMainWithHooks simpleUserHooks { preSDist = \ a b -> copyFile "debian/changelog" "changelog" >> preSDist simpleUserHooks a b } runTestScript lbi = system (buildDir lbi ++ "/cabal-debian-tests/cabal-debian-tests") >>= \ code -> if code == ExitSuccess then return () else error "unit test failure" -- Do all we can to create or update a symbolic link - remove any -- existing file or directory and verify the link contents. ensureSymbolicLink :: FilePath -> FilePath -> IO () ensureSymbolicLink destination location = do result <- try (readSymbolicLink location) case result of Right destination' | destination' == destination -> return () Right _ -> removeAndRepeat Left e -> case ioe_type e of InvalidArgument -> removeAndRepeat NoSuchThing -> createSymbolicLink destination location _ -> error $ "ensureSymbolicLink " ++ show destination ++ " " ++ show location ++ " -> " ++ show e where removeAndRepeat :: IO () removeAndRepeat = do result <- try remove case (result :: Either IOError ()) of Left e -> error $ "Unable to remove " ++ show location ++ ": " ++ show e Right () -> ensureSymbolicLink destination location remove = do fileExists <- doesFileExist location case fileExists of True -> removeFile location False -> do dirExists <- doesDirectoryExist location case dirExists of True -> removeDirectoryRecursive location False -> return () cabal-debian-4.31/CabalDebian.hs0000644000000000000000000000024112565162075014560 0ustar0000000000000000import Debian.Debianize.Details (debianDefaults) import Debian.Debianize.Output (performDebianization) main :: IO () main = performDebianization debianDefaults cabal-debian-4.31/debian/0000755000000000000000000000000012565162075013344 5ustar0000000000000000cabal-debian-4.31/debian/Debianize.hs0000644000000000000000000000410212565162075015567 0ustar0000000000000000-- 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) import Data.Text as Text (pack) import Data.Version (Version(Version)) import Debian.Debianize import Debian.Debianize.Output (performDebianization) import Debian.Debianize.Optparse (parseProgramArguments, CommandLineOptions(..)) import Debian.Relation (BinPkgName(BinPkgName), Relations, parseRelations) import Distribution.Package (PackageName(PackageName)) main :: IO () main = performDebianization customize where customize :: Monad m => CabalT m () customize = do debianDefaults -- Force some values so they match the expected results rather than -- changing as new package versions arrive. mapCabal (PackageName "Cabal") (DebBase "cabal-122") splitCabal (PackageName "Cabal") (DebBase "cabal") (Version [1,22] []) (debInfo . control . maintainer) .= parseMaintainer "David Fox " (debInfo . sourceFormat) .= 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") rels :: String -> Relations rels = either (throw . userError . show) id . parseRelations cabal-debian-4.31/debian/changelog0000644000000000000000000012653312565162075015230 0ustar0000000000000000haskell-cabal-debian (4.30.2) unstable; urgency=low * have runDebianizeScript look for source in src/ as well as ./ -- David Fox Sat, 08 Aug 2015 08:04:02 -0700 haskell-cabal-debian (4.30.1) unstable; urgency=low * Make sure apache configuration files end with .conf -- David Fox Mon, 29 Jun 2015 10:27:47 -0700 haskell-cabal-debian (4.30) unstable; urgency=low * Remove mechanism to pass arguments via the CABALDEBIAN environment variable. * Make compareDebianization a pure function. * Remove MonadIO superclass from some functions -- David Fox Thu, 18 Jun 2015 09:12:59 -0700 haskell-cabal-debian (4.29.3) unstable; urgency=low * Fix escaping of wildcard characters that are not meaningful in cabal (i.e. square brackets) * Fix generation of argument list when running an external debian/Debianization.hs script (the whole thing was being repeated.) * Make sure the enable tests and run tests options are handled correctly (not sure they were wrong, but pretty sure they're now right.) * Export Dmitry's performDebianization function instead of debianize in Debian.Debianize. -- David Fox Sat, 13 Jun 2015 05:24:03 -0700 haskell-cabal-debian (4.29) unstable; urgency=low * Restore the --epoch-map, --cabal-flag, --ghcjs, and --buildenvdir options * Export parseProgramArguments' for parsing internally constructed argument lists. -- David Fox Mon, 08 Jun 2015 06:37:25 -0700 haskell-cabal-debian (4.28) unstable; urgency=low * New command line parsing code from Dmitry Bogatov * Drop support for old package old package formats * Bug fixes and typos, API simplification, more -- David Fox Wed, 13 May 2015 06:49:04 -0700 haskell-cabal-debian (4.27.2) unstable; urgency=low * Change to the contents of the init.d file created for server packages. In Debian.Debianize.Goodies.serverAtoms, insert a line into the init.d script to set the datadir environment variable to /usr/share/cabalname before startup. -- David Fox Wed, 22 Apr 2015 10:25:52 -0700 haskell-cabal-debian (4.27.1) unstable; urgency=low * Fix spurious "Just" in debian/copyright file. -- David Fox Tue, 21 Apr 2015 07:01:35 -0700 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 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 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 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 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 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 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 for official. * Straighten out the test suite options: --no-tests, --no-run-tests -- David Fox Mon, 23 Mar 2015 11:31:14 -0700 haskell-cabal-debian (4.24.5) unstable; urgency=low * Patch from Dmitry Bogatov for filling in debian/copyright fields * Patch from Dmitry Bogatov for debhelper and haskell-devscripts build deps * Patch from Dmitry Bogatov for default changelog message * Add a --no-run-tests flag to control the nocheck option * Compatibility with different GHC versions -- David Fox Sat, 21 Mar 2015 10:14:48 -0700 haskell-cabal-debian (4.24.3) unstable; urgency=low * Always include the test suite build dependencies in debian/control, even if the testEnabled flag is set to False (at the moment it seems as if it always is.) -- David Fox Mon, 02 Mar 2015 17:33:52 -0800 haskell-cabal-debian (4.24.2) unstable; urgency=low * Distinguish between the place we find the data files (dataTop) and the place we put then (dataDest) * Add a case for the ISC license -- David Fox Sun, 22 Feb 2015 15:09:56 -0800 haskell-cabal-debian (4.24.1) unstable; urgency=low * Don't assign the name "cabal-ghcjs" to newer Cabal library versions -- David Fox Sun, 22 Feb 2015 06:08:28 -0800 haskell-cabal-debian (4.24) unstable; urgency=low * Convert from old data-lens package to lens. * Implement --allow-debian-self-build-deps -- David Fox Sat, 14 Feb 2015 06:15:01 -0800 haskell-cabal-debian (4.23.1) unstable; urgency=low * ifdefs for Cabal-1.18, 1.20, and 1.22, ghc-7.6, and 7.8. -- David Fox Sun, 08 Feb 2015 23:21:07 -0800 haskell-cabal-debian (4.23) unstable; urgency=low * Add DEB_ENABLE_TESTS = yes to rules file when appropriate * Add test suite build dependencies when appropriate * Add --no-test-suite option * Add --allow-debian-self-build-deps * Filter out self dependencies in the debian package space, not the cabal package space. * Fix generation of machine readable debian/copyright files * Use the homepage value found in the cabal file * Add travis build file -- David Fox Fri, 06 Feb 2015 06:25:08 -0800 haskell-cabal-debian (4.22) unstable; urgency=low * Big module reorganization for more type safety. -- David Fox Tue, 03 Feb 2015 13:22:29 -0800 haskell-cabal-debian (4.21.1) unstable; urgency=low * Fix --buildenvdir command line option. * Add an option for cabal flags -- David Fox Fri, 30 Jan 2015 13:46:08 -0800 haskell-cabal-debian (4.21) unstable; urgency=low * Split the enormous Atoms record into three layers - the innermost is Flags, which contains information obtained from the command line arguments. Flags is also the argument to the inputCabalization function, which inputs a Cabal PackageDescription. The Flags record is embedded in a DebInfo, which holds information related to the Debianization only. The DebInfo and the PackageDescription are used to build the old Atoms record. DebInfo is the state value of the DebianT monad, while Atoms is the state value of the CabalT monad. The point of all this is to ensure that a PackageDescription exists before we start converting the Cabalization to a Debianization. -- David Fox Thu, 29 Jan 2015 12:29:52 -0800 haskell-cabal-debian (4.20.2) unstable; urgency=low * Do not lowercase the package name when constructing the data file destination directory (/usr/share/). -- David Fox Fri, 16 Jan 2015 05:45:23 -0800 haskell-cabal-debian (4.20.1) unstable; urgency=low * Fix a bug in the computation of the debian maintainer field * Improve rules file generation -- David Fox Wed, 14 Jan 2015 14:38:56 -0800 haskell-cabal-debian (4.20) unstable; urgency=low * Add a --source-section option * Fix handling of debian maintainer and debian uploaders * Improve formatting of debian/rules file * Rename function debianization -> debianize * Rename function finalizeDebianization' -> finalizeDebianization * Rename function getDebianMaintainer -> getCurrentDebianUser -- David Fox Fri, 09 Jan 2015 11:49:04 -0800 haskell-cabal-debian (4.19.3) unstable; urgency=low * Fix issue #23, so that if you run 'cabal-debian' and then 'cabal-debian --compare' it says there are no differences. * Fix issue #16 - set revision if format is Quilt3. -- David Fox Thu, 08 Jan 2015 05:20:32 -0800 haskell-cabal-debian (4.19.2) unstable; urgency=low * Use canonical to put the debianization in a standard form before trying to compare existing and generated. * Fix bug where cabal-debian program processed the command line options twice. * Avoid using paths that point to ../ in the cabal file (even if disabled by a flag), it causes the package to be rejected by hackage. -- David Fox Wed, 07 Jan 2015 13:26:33 -0800 haskell-cabal-debian (4.19.1) unstable; urgency=low * Support Cabal-1.22 * Test whether apt-file is installed (from creichert) * Conditional compilation for new symbols MPL and BSD2 (from creichert) -- David Fox Wed, 07 Jan 2015 12:56:00 -0800 haskell-cabal-debian (4.19) unstable; urgency=low * Add remapCabal function here from a private package * Remove debianVersionSplits, which has long been replaced by debianDefaultAtoms. -- David Fox Mon, 08 Dec 2014 10:07:06 -0800 haskell-cabal-debian (4.18) unstable; urgency=low * Add types to support machine readable copyright files. * Add --debian-base-name option and overrideDebianBaseName lens. * Add --omit-prof-version-deps option flag, have --official imply it -- David Fox Thu, 27 Nov 2014 07:11:35 -0800 haskell-cabal-debian (4.17.5) unstable; urgency=low * Use the prettyclass package and the PP wrappers in the latest debian package to do pretty printing. * Change default priority to extra * Use the new watch file suggested by nomeata * Use the control file template suggested in issue #3 -- David Fox Mon, 15 Sep 2014 13:28:36 -0700 haskell-cabal-debian (4.17.4) unstable; urgency=low * Add missing ifdefs to hide the GHCJS constructor when ghcjs-support flag is False. * Require Cabal < 1.21 when ghcjs-support flag is False. -- David Fox Tue, 02 Sep 2014 09:06:20 -0700 haskell-cabal-debian (4.17.3) unstable; urgency=low * Moved source repository to github.com. -- David Fox Fri, 29 Aug 2014 13:55:26 -0700 haskell-cabal-debian (4.17.2) unstable; urgency=low * Fix formatting of the generated debian/*.install files. -- David Fox Tue, 19 Aug 2014 16:04:27 -0700 haskell-cabal-debian (4.17.1) unstable; urgency=low * Fix install of ghcjs executables - there was an extra subdir. * Don't append -ghcjs to default package name. -- David Fox Tue, 19 Aug 2014 10:15:46 -0700 haskell-cabal-debian (4.17) unstable; urgency=low * Fix bug in architecture dependent build dependency generation - it was getting the indep dependencies as well. * Support GHCJS executable packages, which are directories with the extension .jsexe. -- David Fox Mon, 18 Aug 2014 17:31:35 -0700 haskell-cabal-debian (4.16.1) unstable; urgency=low * Support for packaging libraries produced by the GHCJS compiler. * Generate debianizations that include libraries for multiple compiler flavors (not yet suppored in haskell-devscripts and/or Cabal.) * Put a DEB_DEFAULT_COMPILER assignment in debian/rules if we can infer it from the command line options. -- David Fox Sat, 16 Aug 2014 07:56:50 -0700 haskell-cabal-debian (4.15.2) unstable; urgency=low * Lowercase the strings in the extraLibs argument of allBuildDepends before wrapping them in BinPkgName. Those types, which come from the debian package, should be opaque and do this whenever a BinPkgName (or SrcPkgName) is created, because upper case is never ok in Debian source or binary package names. In the meantime I will make this requested change. Thanks to Sven Bartscher for pointing this out. -- David Fox Tue, 12 Aug 2014 07:47:17 -0700 haskell-cabal-debian (4.15.1) unstable; urgency=low * Add Data and Typeable instances. -- David Fox Thu, 17 Jul 2014 11:22:17 -0700 haskell-cabal-debian (4.15) unstable; urgency=low * Don't hardcode the compiler name in makefile targets. -- David Fox Sat, 12 Jul 2014 12:15:10 -0700 haskell-cabal-debian (4.14) unstable; urgency=low * Move the code to map the cabal package named "Cabal" to the debian package named "libghc-cabal-*" from the seereason defaults to the debian defaults. -- David Fox Mon, 07 Jul 2014 08:35:39 -0700 haskell-cabal-debian (4.13) unstable; urgency=low * Add a flag for ghcjs support. -- David Fox Thu, 03 Jul 2014 12:05:21 -0700 haskell-cabal-debian (4.12) unstable; urgency=low * Remove the Top type and argument - use getWorkingDirectory instead. -- David Fox Sun, 29 Jun 2014 08:11:01 -0700 haskell-cabal-debian (4.11) unstable; urgency=low * Use MonadIO instead of IO for all signatures. This is so we can more easily use cabal debian from a Shelly script. -- David Fox Sun, 29 Jun 2014 07:16:45 -0700 haskell-cabal-debian (4.10.1) unstable; urgency=low * Fix a tail exception in builtIn. -- David Fox Tue, 17 Jun 2014 07:21:22 -0700 haskell-cabal-debian (4.10) unstable; urgency=low * Rename knownVersionSplits -> debianVersionSplits and move to Debian.Debianize.Details. (Should that be renamed Debian.Debianize.Debian?) * Add HC=ghc or HC=ghcjs to header of debian/rules depending on the value of the compilerFlavor atom. -- David Fox Sat, 14 Jun 2014 10:20:01 -0700 haskell-cabal-debian (4.9) unstable; urgency=low * Generate the library package prefix, previously hard coded as libghc-, using the CompilerFlavor value, so we get libghcjs-foo-dev when using ghcjs. -- David Fox Fri, 13 Jun 2014 09:58:13 -0700 haskell-cabal-debian (4.8) unstable; urgency=low * Add a --no-hoogle flag to omit the hoogle documentation link. This link doesn't contain the package's version number, so it will conflict with other versions of the library (such as those built into ghc.) -- David Fox Tue, 10 Jun 2014 10:42:38 -0700 haskell-cabal-debian (4.7.1) unstable; urgency=low * Fix the code added in 4.7. * Add --recommends and --suggests options, similar to --depends et. al. -- David Fox Tue, 03 Jun 2014 07:14:52 -0700 haskell-cabal-debian (4.7) unstable; urgency=low * Improve the treatment of dependencies which are built into ghc. This will allow the use of newer libraries than the ones built into ghc, provided they are given deb names that are different than the one ghc specifically conflicts with. For example, a newer version of Cabal could be used if it was in the deb package libghc-cabal-ghcjs-dev. To change the debian names of libraries we need to use the mapCabal and splitCabal functions, as is done in the autobuilder-seereason module Debian.AutoBuilder.Details.Atoms. -- David Fox Mon, 02 Jun 2014 14:28:59 -0700 haskell-cabal-debian (4.6.2) unstable; urgency=low * Move a seereason specific function from here to the autobuilder-seereason package. -- David Fox Mon, 02 Jun 2014 11:03:13 -0700 haskell-cabal-debian (4.6.1) unstable; urgency=low * Don't compute the current ghc version so often. -- David Fox Fri, 30 May 2014 13:40:12 -0700 haskell-cabal-debian (4.6) unstable; urgency=low * Add a --default-package option to change haskell-packagename-utils to some other name. * Fix treatment of cabalfile Data-Dir field - it describes where the data files are in the source tree, but shouldn't affect where they will be installed. -- David Fox Thu, 29 May 2014 08:27:54 -0700 haskell-cabal-debian (4.5) unstable; urgency=low * Remove the ghcVersion field and lens. -- David Fox Mon, 05 May 2014 11:55:53 -0700 haskell-cabal-debian (4.4) unstable; urgency=low * Add the copytruncate directive to logrotate files we generate. As things were, hslogger would continue writing to the deleted log file after it was rotated. -- David Fox Sun, 30 Mar 2014 13:05:48 -0700 haskell-cabal-debian (4.3.2) unstable; urgency=low * Speed up debianization by computing the ghc version once when we enter the DebT monad rather than repeatedly. It is slow because it needs to chroot. -- David Fox Fri, 28 Mar 2014 13:03:57 -0700 haskell-cabal-debian (4.3.1) unstable; urgency=low * Safer default value for buildEnv - "/" instead of "". This is where we look for the GHC version number. -- David Fox Thu, 27 Mar 2014 06:12:28 -0700 haskell-cabal-debian (4.3) unstable; urgency=low * Make the default value for buildEnv "/", this makes it normally look at the version number of the ghc compiler installed in the root environment. -- David Fox Mon, 24 Mar 2014 06:01:49 -0700 haskell-cabal-debian (4.2) unstable; urgency=low * Get the GHC compiler version from the build environment, which now needs to be explicitly set. -- David Fox Fri, 07 Mar 2014 10:58:37 -0800 haskell-cabal-debian (4.1.1) unstable; urgency=low * Remove build dependency on ansi-wl-pprint. * Split module Debian.Debianize.BuildDependencies out of Debian.Debianize.Finalize -- David Fox Sun, 02 Feb 2014 07:37:03 -0800 haskell-cabal-debian (4.0.6) unstable; urgency=low * Ifdef out duplicate instances for Cabal-1.18.0 - thanks to Tom Nielsen. -- David Fox Tue, 28 Jan 2014 17:10:48 -0800 haskell-cabal-debian (4.0.5) unstable; urgency=low * Changes for debian-3.81 - use the pretty printer in Debian.Pretty instead of ansi-wl-pprint. -- David Fox Tue, 14 Jan 2014 05:02:59 -0800 haskell-cabal-debian (4.0.4) unstable; urgency=low * Restore the test data, the problem I had with long filenames is solved by using cabal sdist to create the tarball rather than runhaskell Setup sdist. -- David Fox Wed, 18 Dec 2013 09:37:34 -0800 haskell-cabal-debian (4.0.3) unstable; urgency=low * Include the build dependencies of the executables in the debian source deb build dependencies. -- David Fox Tue, 10 Dec 2013 14:37:20 -0800 haskell-cabal-debian (4.0.2) unstable; urgency=low * Export some lens state operators from Prelude. -- David Fox Tue, 10 Dec 2013 05:38:00 -0800 haskell-cabal-debian (4.0.1) unstable; urgency=low * Make sure the utilities package gets created even if no name has been specified for it - use the name generated in DebianNames.hs. -- David Fox Tue, 10 Dec 2013 05:10:11 -0800 haskell-cabal-debian (4.0.0) unstable; urgency=low * Massive lens overhaul -- David Fox Thu, 05 Dec 2013 12:26:31 -0800 haskell-cabal-debian (3.10.3) unstable; urgency=low * Go back to using lens interface directly * Collect debianization fact code in Facts/ -- David Fox Sun, 24 Nov 2013 10:40:02 -0800 haskell-cabal-debian (3.10.2) unstable; urgency=low * Make some signatures in Monad.hs clearer -- David Fox Wed, 20 Nov 2013 14:26:28 -0800 haskell-cabal-debian (3.10.1) unstable; urgency=low * More API changes - want need to get all the clients in sync before proceeding. -- David Fox Tue, 19 Nov 2013 11:31:16 -0800 haskell-cabal-debian (3.10) unstable; urgency=low * Add a monadic interface -- David Fox Sat, 16 Nov 2013 10:42:02 -0800 haskell-cabal-debian (3.9) unstable; urgency=low * Clean up documentation * Allow more than one utility package name, each of which will get copies of the data-files and leftover executables. * Make the --debianize option a no-op, the behavior is now the default. * Update the unit tests and build an executable to run them. * Copy debian/changelog to top directory at beginning of build so hackage will see it. -- David Fox Tue, 05 Nov 2013 11:34:48 -0800 haskell-cabal-debian (3.8.3) unstable; urgency=low * Add an ifdef for compatibility with GHC-7.4.1. -- David Fox Sun, 20 Oct 2013 15:50:47 -0700 haskell-cabal-debian (3.8.2) unstable; urgency=low * Actually, copy changelog from debian/changelog before building sdist tarball. -- David Fox Tue, 15 Oct 2013 06:42:39 -0700 haskell-cabal-debian (3.8.1) unstable; urgency=low * Move changelog top top directory so hackage will see it. -- David Fox Tue, 15 Oct 2013 06:24:25 -0700 haskell-cabal-debian (3.8) unstable; urgency=low * Downcase the package name to build the datadir name in /usr/share, this matches the paths in dist/autogen/Paths_packagename. -- David Fox Mon, 14 Oct 2013 20:48:39 -0700 haskell-cabal-debian (3.7) unstable; urgency=low * Change path to hackage tarball in watch file for hackage2. -- David Fox Fri, 04 Oct 2013 09:22:51 -0700 haskell-cabal-debian (3.6) unstable; urgency=low * Require haskell-devscripts >= 0.8.19. This version changes the value of datasubdir from /usr/share/packagename-packageversion to simply /usr/share/packagename. This could break some packaging. -- David Fox Fri, 06 Sep 2013 16:48:18 -0700 haskell-cabal-debian (3.5) unstable; urgency=low * Allow full lists of debian relations to be passed to the --build-dep argument, not just a single package name. -- David Fox Sun, 01 Sep 2013 07:08:37 -0700 haskell-cabal-debian (3.4.3) unstable; urgency=low * Fix the repository location in the cabal file. -- David Fox Sat, 31 Aug 2013 07:57:15 -0700 haskell-cabal-debian (3.4.2) unstable; urgency=low * Notify user when debhelper isn't installed. * Avoid use of partial function read -- David Fox Mon, 24 Jun 2013 13:51:51 -0700 haskell-cabal-debian (3.4.1) unstable; urgency=low * Remove call to test script in Setup.hs * Remove unused dependencies -- David Fox Mon, 10 Jun 2013 09:12:38 -0700 haskell-cabal-debian (3.4) unstable; urgency=low * Add support for modifying the Provides and Replaces fields. -- David Fox Sun, 09 Jun 2013 14:18:39 -0700 haskell-cabal-debian (3.3.2) unstable; urgency=low * Changes for debian-3.71 -- David Fox Sun, 14 Apr 2013 13:32:04 -0700 haskell-cabal-debian (3.3.1) unstable; urgency=low * Don't fail during dry run if the existing debianization has no copyright file. -- David Fox Wed, 13 Mar 2013 10:00:25 -0700 haskell-cabal-debian (3.3) unstable; urgency=low * Add Debian.Debianize.Details, with default Atoms values for Debian and SeeReason. -- David Fox Mon, 11 Mar 2013 11:44:10 -0700 haskell-cabal-debian (3.2.5) unstable; urgency=low * Add move the VersionSplits type into a module, and fix the code that splits the mapping of cabal to debian names over a version range. -- David Fox Tue, 05 Mar 2013 05:17:03 -0800 haskell-cabal-debian (3.2.4) unstable; urgency=low * Fix long standing bug in Debian.Debianize.Interspersed.foldTriples. -- David Fox Sun, 03 Mar 2013 09:45:14 -0800 haskell-cabal-debian (3.2.3) unstable; urgency=low * Clean up mapping from cabal names to debian names. -- David Fox Sat, 02 Mar 2013 07:36:16 -0800 haskell-cabal-debian (3.2.2) unstable; urgency=low * Remove unused Debian.Debianize.Generic and Triplets modules. -- David Fox Fri, 01 Mar 2013 11:14:33 -0800 haskell-cabal-debian (3.2.1) unstable; urgency=low * Do not add the options +RTS -IO -RTS to the server options, this is a security risk. Instead, server executables should built with -with-rtsopts=-IO. -- David Fox Thu, 28 Feb 2013 09:02:39 -0800 haskell-cabal-debian (3.2) unstable; urgency=low * Strip executables when installing (well, at least some. There may be more work to do here.) * Change the build dependency type from BinPkgName to Relation, so we can specify version dependencies (though as yet not or relations.) -- David Fox Tue, 26 Feb 2013 07:17:30 -0800 haskell-cabal-debian (3.1.1) unstable; urgency=low * Fix the code in the init file that checks for and sources a file in /etc/default. -- David Fox Mon, 25 Feb 2013 14:46:02 -0800 haskell-cabal-debian (3.1) unstable; urgency=low * Create a Top type to represent the top directory of a debianization * Change the signature of Debian.Debianize.debianization so it notices command line arguments and environment arguments. -- David Fox Fri, 22 Feb 2013 13:28:30 -0800 haskell-cabal-debian (3.0.7) unstable; urgency=low * Fix to copyright/license code * have the init script load /etc/default/packagename if available * Add an alternative function to showCommandForUser (called showCommand) that uses double quotes instead of single quotes so you can reference shell variables. -- David Fox Wed, 20 Feb 2013 09:29:11 -0800 haskell-cabal-debian (3.0.6) unstable; urgency=low * When packaging a web site or server, don't add code to the postinst to start a server, it gets generated by debhelper. * Add the changelog and the Debianize.hs file to extra-source-files. * Add HTTP=1 to the list of known epoch mappings. -- David Fox Thu, 14 Feb 2013 14:41:17 -0800 haskell-cabal-debian (3.0.5) unstable; urgency=low * Compatibility with ghc-7.4 -- David Fox Wed, 13 Feb 2013 10:48:19 -0800 haskell-cabal-debian (3.0.4) unstable; urgency=low * Add dependency on debian-policy, so we can compute the latest standards-version. * Documentation improvements * Test case improvements * Error message improvements -- David Fox Sun, 10 Feb 2013 11:03:55 -0800 haskell-cabal-debian (3.0.3) unstable; urgency=low * Due to a typo, the noDocumentationLibrary lens was turning off profiling rather than documentation. -- David Fox Fri, 08 Feb 2013 17:14:09 -0800 haskell-cabal-debian (3.0.2) unstable; urgency=low * Fix argument and exception handling in cabal-debian * Make Standards-Version field non-mandatory * Make sure every binary deb paragraph has a non-empty description -- David Fox Thu, 07 Feb 2013 10:03:25 -0800 haskell-cabal-debian (3.0.1) unstable; urgency=low * Don't build Debian version numbers with revision (Just ""). * Output the descriptions of the binary packages. -- David Fox Tue, 05 Feb 2013 14:48:33 -0800 haskell-cabal-debian (3.0) unstable; urgency=low * Moved the Distribution.Debian modules to Debian.Cabal and Debian.Debianize. * Refactored the debianize function for easier testing * Added test cases. * Add a Debianization type that intends to fully describe a debian package, with functions to read, build, modify, and write a Debianization. -- David Fox Wed, 26 Dec 2012 05:45:35 -0800 haskell-cabal-debian (2.6.3) unstable; urgency=low * Fix pretty printing of Relations (i.e. dependency lists.) There is an instance for printing lists in ansi-wl-pprint which prevents us from writing customized Pretty instances for type aliases like Relations, AndRelation, and OrRelation. -- David Fox Fri, 04 Jan 2013 09:30:48 -0800 haskell-cabal-debian (2.6.2) unstable; urgency=low * Fix a bug constructing the destination pathnames that was dropping files that were supposed to be installed into packages. -- David Fox Thu, 20 Dec 2012 06:49:25 -0800 haskell-cabal-debian (2.6.1) unstable; urgency=low * Remove the modifyAtoms field from the Flags record, we want to be able to create instances like Read and Show for this type. The modifyAtoms function is now passed separately to debianize. * The flags field of Server was renamed serverFlags because the newly exported Config record has a flags field. -- David Fox Wed, 19 Dec 2012 09:45:22 -0800 haskell-cabal-debian (2.5.10) unstable; urgency=low * Filter cabal self dependencies out before generating Build-Depends-Indep, just as we added code to filter them out of Build-Depends in version 2.5.7. -- David Fox Tue, 18 Dec 2012 13:23:39 -0800 haskell-cabal-debian (2.5.9) unstable; urgency=low * Always add +RTS -IO -RTS to server flags. -- David Fox Sun, 16 Dec 2012 10:40:52 -0800 haskell-cabal-debian (2.5.8) unstable; urgency=low * Add a builtin list for ghc-7.6.1. -- David Fox Sat, 15 Dec 2012 07:04:49 -0800 haskell-cabal-debian (2.5.7) unstable; urgency=low * Filter out cabal self-dependencies before building the debian dependencies. In cabal a self dependency means you need the library to build an executable, while in debian it means you need an older version installed to build the current version. -- David Fox Thu, 29 Nov 2012 08:42:30 -0800 haskell-cabal-debian (2.5.6) unstable; urgency=low * Don't add --base-uri and --http-port arguments automatically, they can be computed by calling the oldClckwrksFlags function and adding the value to the flags field. Clckwrks-0.3 no longer needs the --base-uri argument. -- David Fox Tue, 27 Nov 2012 13:34:31 -0800 haskell-cabal-debian (2.5.5) unstable; urgency=low * Have the debianize function return False if there is no debian/Debianize.hs file, but throw an exception if running it failed, so we notice bad debianization code. -- David Fox Tue, 27 Nov 2012 07:34:51 -0800 haskell-cabal-debian (2.5.4) unstable; urgency=low * Insert "SetEnv proxy-sendcl 1" line into Apache config. -- David Fox Tue, 20 Nov 2012 13:43:54 -0800 haskell-cabal-debian (2.5.3) unstable; urgency=low * Remove extra copy of binary from the executable debs * Add a sourcePackageName field to Flags, and a --source-package-name command line option. -- David Fox Sat, 17 Nov 2012 00:16:21 -0800 haskell-cabal-debian (2.5.2) unstable; urgency=low * Fix the path to where the DHInstallTo and DHInstallCabalExecTo DebAtoms put their files. -- David Fox Fri, 16 Nov 2012 18:11:45 -0800 haskell-cabal-debian (2.5.1) unstable; urgency=low * Add a destName field to Executable so we can give installed executables a different name than they had in the build. -- David Fox Fri, 16 Nov 2012 15:37:16 -0800 haskell-cabal-debian (2.5) unstable; urgency=low * Add a debName field to the Executable record, before the deb package name had to equal the executable name. -- David Fox Fri, 16 Nov 2012 12:32:39 -0800 haskell-cabal-debian (2.4.2) unstable; urgency=low * Move location of cabal install files from dist/build/install to debian/cabalInstall, the dist directory was getting wiped at bad moments. * Split the autobuilder function autobuilderDebianize into two new functions in cabal-debian: runDebianize and callDebianize. * Custom debianization code now goes in debian/Debianize.hs rather than in setup, so we can distinguish it failing from it not existing more easily. -- David Fox Thu, 15 Nov 2012 11:00:08 -0800 haskell-cabal-debian (2.4.1) unstable; urgency=low * We need to verify that debian/compat was created after running the debianize function, because ghc still exits with ExitSuccess -- David Fox Thu, 15 Nov 2012 06:34:02 -0800 haskell-cabal-debian (2.4.0) unstable; urgency=low * You can run a function in Setup.hs other than main using ghc -e, so we will use this trick to run the debianize function directly rather than running main. * Eliminate the autobuilderDebianize function. -- David Fox Thu, 15 Nov 2012 04:05:49 -0800 haskell-cabal-debian (2.3.4) unstable; urgency=low * Fix the builddir used when running the cabal-debian standalone executable - it was dist-cabal/build, so the resulting debianization had files in places where cabal didn't expect them. -- David Fox Tue, 13 Nov 2012 06:20:51 -0800 haskell-cabal-debian (2.3.3) unstable; urgency=low * Eliminate class MonadBuild and the BuildT monad. -- David Fox Sun, 11 Nov 2012 17:46:31 -0800 haskell-cabal-debian (2.3.2) unstable; urgency=low * Fix exception that was keeping changelogs from being preserved. -- David Fox Sat, 10 Nov 2012 10:07:50 -0800 haskell-cabal-debian (2.3.1) unstable; urgency=low * Fix the extension of the debhelper links files * Add a general mechanism for installing a file into a deb when we have the file's text in a String (rather than in a file.) -- David Fox Sat, 10 Nov 2012 07:35:09 -0800 haskell-cabal-debian (2.3) unstable; urgency=low * Add MonadBuild. -- David Fox Fri, 09 Nov 2012 12:21:14 -0800 haskell-cabal-debian (2.2.1) unstable; urgency=low * Add a modifyAtoms function to Flags that is applied to final list of DebAtom before writing the debianization. * Add DHApacheSite and DHInstallCabalExec atoms so atoms don't depend on the build directory * Add #DEBHELPER# and exit 0 to default web server postinst. -- David Fox Fri, 09 Nov 2012 10:25:32 -0800 haskell-cabal-debian (2.2.0) unstable; urgency=low * Append a trailing slash to the --base-uri argument passed to the server. This is required by Web.Routes.Site.runSite. -- David Fox Thu, 08 Nov 2012 04:40:08 -0800 haskell-cabal-debian (2.1.4) unstable; urgency=low * Merge the Executable and Script constructors of the Executable type * Add a destDir field to Executable to specify the destination. -- David Fox Tue, 06 Nov 2012 13:24:25 -0800 haskell-cabal-debian (2.1.3) unstable; urgency=low * Don't append a slash to the base-uri. * Construct the name of the data directory in /usr/share from the cabal package name rather than the debian source package name. * Add a --self-depend flag to include a build dependency on this library in all generated debianizations. -- David Fox Tue, 06 Nov 2012 07:07:57 -0800 haskell-cabal-debian (2.1.2) unstable; urgency=low * Output the server support files. -- David Fox Tue, 06 Nov 2012 06:37:18 -0800 haskell-cabal-debian (2.1.1) unstable; urgency=low * Restore code that checks for version number match when validating a debianization. The autobuilder can now pass the version number to cabal-debian, so it should match. -- David Fox Mon, 05 Nov 2012 17:42:32 -0800 haskell-cabal-debian (2.1.0) unstable; urgency=low * Enable processing of Script, Server and WebSite executables. -- David Fox Mon, 05 Nov 2012 12:45:42 -0800 haskell-cabal-debian (2.0.9) unstable; urgency=low * Add a Library section, export all the modules. -- David Fox Mon, 05 Nov 2012 06:41:25 -0800 haskell-cabal-debian (2.0.8) unstable; urgency=low * Bypass abandoned versions. -- David Fox Sat, 03 Nov 2012 06:13:27 -0700 haskell-cabal-debian (1.26) unstable; urgency=low * Don't try to update the existing debianization, except for the changelog where we retain entries that look older than the one we generate. * Use .install files instead of adding rules to debian/rules * Add --depends and --conflicts options -- David Fox Thu, 25 Oct 2012 12:03:49 -0700 haskell-cabal-debian (1.25) unstable; urgency=low * If the --disable-haddock flag is given omit the doc package from the control file. * The tarball that was uploaded to Hackage as version 1.24 had a (buggy) change which was not pushed to darcs. This resolves that confusion. -- David Fox Sat, 16 Jun 2012 14:42:12 -0700 haskell-cabal-debian (1.24) unstable; urgency=low * No wonder it doesn't build on hackage - none of the source modules were shipped. -- David Fox Thu, 14 Jun 2012 08:19:19 -0700 haskell-cabal-debian (1.23) unstable; urgency=low * Add a --quilt option to switch from native to quilt format. Without this option the file debian/source/format will contain '3.0 (native)', with it '3.0 (quilt)'. -- David Fox Fri, 01 Jun 2012 05:53:36 -0700 haskell-cabal-debian (1.22) unstable; urgency=low * Bump version to make sure all changes are uploaded. -- David Fox Wed, 23 May 2012 19:54:17 -0700 haskell-cabal-debian (1.21) unstable; urgency=low * fix conversion of wildcards into intersected ranges -- David Fox Wed, 23 May 2012 19:51:34 -0700 haskell-cabal-debian (1.20) unstable; urgency=low * Fix generation of debian library dependencies from the Extra-Libraries field of the cabal file. -- David Fox Wed, 23 May 2012 19:50:39 -0700 haskell-cabal-debian (1.19) unstable; urgency=low * Handle cabal equals dependencies. -- David Fox Tue, 20 Mar 2012 14:34:58 -0700 haskell-cabal-debian (1.18) unstable; urgency=low * High level of confidence this time. Interesting new Interspersed class, and an implementation of invertVersionRanges which should be forwarded to the Cabal folks. * Removes dependency on logic-classes -- David Fox Tue, 20 Mar 2012 08:17:25 -0700 haskell-cabal-debian (1.17) unstable; urgency=low * Restore code to downcase cabal package name before using it as the base of the debian package name. -- David Fox Sun, 18 Mar 2012 15:32:04 -0700 haskell-cabal-debian (1.16) unstable; urgency=low * Remove code that implements a special case for the debian name of the haskell-src-exts package. -- David Fox Sun, 18 Mar 2012 14:11:21 -0700 haskell-cabal-debian (1.15) unstable; urgency=low * Yet another stab at fixing the code for converting cabal dependencies to debian dependencies, with support for splitting version ranges of cabal files among different debian packages. -- David Fox Fri, 16 Mar 2012 17:59:28 -0700 haskell-cabal-debian (1.14) unstable; urgency=low * Don't try to strip data files * Use permissions 644 for data files, not 755. -- David Fox Wed, 07 Mar 2012 14:46:04 -0800 haskell-cabal-debian (1.13) unstable; urgency=low * Append the version number when constructing the directory for data files. -- David Fox Wed, 07 Mar 2012 08:56:39 -0800 haskell-cabal-debian (1.12) unstable; urgency=low * Include any files listed in the Data-Files field of the cabal file in the utils package. -- David Fox Tue, 06 Mar 2012 11:31:47 -0800 haskell-cabal-debian (1.11) unstable; urgency=low * Replace --epoch flag with --epoch-map, so we can specify epoch numbers for both the package being built and for dependency packages. -- David Fox Thu, 09 Feb 2012 07:01:19 -0800 haskell-cabal-debian (1.10) unstable; urgency=low * Add bundled package list for ghc 7.4.1. -- David Fox Sat, 04 Feb 2012 14:44:33 -0800 haskell-cabal-debian (1.9) unstable; urgency=low * Add --dep-map flag to allow mapping of cabal package names to the base of a debian package name. This modifies the name to which the prefix "lib" and the suffix "-dev" are added. * Fix dependency generation bug introduced in 1.8. -- David Fox Mon, 23 Jan 2012 14:13:05 -0800 haskell-cabal-debian (1.8) unstable; urgency=low * Add a --dev-dep flag to make one or more packages install dependencies of the dev package. -- David Fox Mon, 23 Jan 2012 05:00:46 -0800 haskell-cabal-debian (1.7) unstable; urgency=low * Add info about ghc 7.4.0 pre-release. -- David Fox Wed, 11 Jan 2012 09:57:45 -0800 haskell-cabal-debian (1.6) unstable; urgency=low * Don't omit dependencies built into ghc, they should be satisfied by the Provides in the compiler if they are not available in the repository. However, we do need to make ghc an alterantive to any versioned dependencies that are bundled with the compiler, since the built in dependencies are virtual packages and thus unversioned. -- David Fox Wed, 07 Dec 2011 06:10:17 -0800 haskell-cabal-debian (1.5) unstable; urgency=low * Fix the generation of build dependency version ranges by using an intermediate version range type. * If the version range for the cabal file touches two different debian package, don't try to write build dependencies that allow either one, it can't really be done. Just give the allowable versions of the newer package (e.g. libghc-parsec3-dev rather than libghc-parsec2-dev.) -- David Fox Sun, 04 Dec 2011 05:59:25 -0800 haskell-cabal-debian (1.4) unstable; urgency=low * Add a --revision flag which appends a (perhaps empty) string cabal version number to get the debian version number. Without this flag the string "-1~hackage1" is appended. * Make it an error to specify a debian version via --deb-version that is older than the current cabal version. -- David Fox Sun, 20 Nov 2011 06:45:33 -0800 haskell-cabal-debian (1.3) unstable; urgency=low * Fix error message when compiler version is not in bundled package list. * Add bundled package list for compiler 7.0.4 (same as 7.0.3.) -- David Fox Sat, 08 Oct 2011 07:58:19 -0700 haskell-cabal-debian (1.2) unstable; urgency=low * When computing the debian name from a package's cabal name, if we have no particular version number we are comparing to, use the name from the version split that corresponds to newer version numbers. * Add code to make the cabal package haskell-src-exts map to the debian packages libghc-src-exts-dev etc. Normally it would map to libghc-haskell-src-exts-dev. -- David Fox Thu, 06 Oct 2011 09:27:02 -0700 haskell-cabal-debian (1.1) unstable; urgency=low * Use propositional logic package to compute normal form for dependencies * Make sure to correct format of cabal package synopsis before using as debian package description. -- David Fox Fri, 30 Sep 2011 06:16:34 -0700 haskell-cabal-debian (1.0) unstable; urgency=low * Debianization generated by cabal-debian -- David Fox Sun, 18 Sep 2011 06:40:21 -0700 cabal-debian-4.31/debian-haskell/0000755000000000000000000000000012565162075014765 5ustar0000000000000000cabal-debian-4.31/debian-haskell/Debian/0000755000000000000000000000000012565162075016147 5ustar0000000000000000cabal-debian-4.31/debian-haskell/Debian/Loc.hs0000644000000000000000000000233512565162075017223 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables, StandaloneDeriving, TemplateHaskell #-} module Debian.Loc ( __LOC__ , mapExn ) where import Control.Applicative ((<$>), (<*>), pure) import Control.Exception (Exception, throw) import Control.Monad.Catch (MonadCatch, catch) import Language.Haskell.TH __LOC__ :: Q Exp __LOC__ = location >>= \ x -> recConE 'Loc [ (,) <$> (pure 'loc_filename) <*> litE (stringL (loc_filename x)) , (,) <$> (pure 'loc_package) <*> litE (stringL (loc_package x)) , (,) <$> (pure 'loc_module) <*> litE (stringL (loc_module x)) , (,) <$> (pure 'loc_start) <*> [|($(litE (integerL (fromIntegral (fst (loc_start x))))), $(litE (integerL (fromIntegral (snd (loc_start x)))))) :: (Int, Int)|] , (,) <$> (pure 'loc_end) <*> [|($(litE (integerL (fromIntegral (fst (loc_end x))))), $(litE (integerL (fromIntegral (snd (loc_end x)))))) :: (Int, Int)|] ] mapExn :: forall e m a. (MonadCatch m, Exception e) => m a -> (e -> e) -> m a mapExn task f = task `catch` (\ (e :: e) -> throw (f e)) cabal-debian-4.31/debian-haskell/Debian/UTF8.hs0000644000000000000000000000166012565162075017234 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | There are old index files that have funky characters like 'ø' -- that are not properly UTF8 encoded. As far as I can tell, these -- files are otherwise plain ascii, so just naivelyinsert the -- character into the output stream. module Debian.UTF8 ( decode , readFile ) where #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif import qualified Data.ByteString.Char8 as B (concat) import qualified Data.ByteString.Lazy.Char8 as L (ByteString, readFile, toChunks) import Data.Char (chr) import Data.Text as T import Data.Text.Encoding (decodeUtf8With) import Data.Word (Word8) import Prelude hiding (readFile) decode :: L.ByteString -> T.Text decode b = decodeUtf8With e (B.concat (L.toChunks b)) where e :: String -> Maybe Word8 -> Maybe Char e _description w = fmap (chr . fromIntegral) w readFile :: FilePath -> IO T.Text readFile path = decode <$> L.readFile path cabal-debian-4.31/debian-haskell/Debian/Changes.hs0000644000000000000000000003656612565162075020073 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-missing-signatures #-} -- |Changelog and changes file support. module Debian.Changes ( ChangesFile(..) , ChangedFileSpec(..) , changesFileName , ChangeLog(..) , ChangeLogEntry(..) , parseChangeLog , parseEntries -- was parseLog , parseEntry , parseChanges ) where import Data.Either (partitionEithers) import Data.List (intercalate, intersperse) import Data.Monoid ((<>)) import Data.Text (Text, pack, unpack, strip) import Debian.Arch (Arch, prettyArch) import qualified Debian.Control.String as S import Debian.Pretty (PP(..)) import Debian.Release import Debian.URI() import Debian.Version import System.Posix.Types import Text.Regex.TDFA hiding (empty) import Text.PrettyPrint (Doc, text, hcat, render) import Text.PrettyPrint.HughesPJClass (Pretty(pPrint)) -- |A file generated by dpkg-buildpackage describing the result of a -- package build data ChangesFile = Changes { changeDir :: FilePath -- ^ The full pathname of the directory holding the .changes file. , changePackage :: String -- ^ The package name parsed from the .changes file name , changeVersion :: DebianVersion -- ^ The version number parsed from the .changes file name , changeRelease :: ReleaseName -- ^ The Distribution field of the .changes file , changeArch :: Arch -- ^ The architecture parsed from the .changes file name , changeInfo :: S.Paragraph' Text -- ^ The contents of the .changes file , changeEntry :: ChangeLogEntry -- ^ The value of the Changes field of the .changes file , changeFiles :: [ChangedFileSpec] -- ^ The parsed value of the Files attribute } deriving (Eq, Read, Show) -- |An entry in the list of files generated by the build. data ChangedFileSpec = ChangedFileSpec { changedFileMD5sum :: String , changedFileSHA1sum :: String , changedFileSHA256sum :: String , changedFileSize :: FileOffset , changedFileSection :: SubSection , changedFilePriority :: String , changedFileName :: FilePath } deriving (Eq, Read, Show) -- |A changelog is a series of ChangeLogEntries data ChangeLogEntry = Entry { logPackage :: String -- FIXME: Should be a SrcPkgName , logVersion :: DebianVersion , logDists :: [ReleaseName] , logUrgency :: String , logComments :: String , logWho :: String , logDate :: String } | WhiteSpace String -- ^ The parser here never returns this deriving (Eq, Read, Show) newtype ChangeLog = ChangeLog [ChangeLogEntry] deriving (Eq, Read, Show) {- instance Show ChangesFile where show = changesFileName -} changesFileName :: ChangesFile -> String changesFileName = render . pPrint . PP instance Pretty (PP ChangesFile) where pPrint (PP changes) = text (changePackage changes ++ "_") <> prettyDebianVersion (changeVersion changes) <> text "_" <> prettyArch (changeArch changes) <> text ".changes" instance Pretty (PP ChangedFileSpec) where pPrint (PP file) = text (changedFileMD5sum file <> " " <> show (changedFileSize file) <> " " <> sectionName (changedFileSection file) <> " " <> changedFilePriority file <> " " <> changedFileName file) instance Pretty (PP ChangeLogEntry) where pPrint (PP (Entry package ver dists urgency details who date)) = hcat [ text package <> text " (" <> prettyDebianVersion ver <> text (") " <> intercalate " " (map releaseName' dists) ++ "; urgency=" ++ urgency) , text "\n\n" , text " " <> text (strip' details) , text "\n\n" , text (" -- " <> who <> " " <> date) , text "\n" ] pPrint (PP (WhiteSpace _)) = error "instance Pretty ChangeLogEntry" instance Pretty (PP [ChangeLogEntry]) where pPrint = hcat . intersperse (text "\n") . map (pPrint . PP) . unPP strip' = unpack . strip . pack instance Pretty (PP ChangeLog) where pPrint (PP (ChangeLog xs)) = hcat (intersperse (text "\n") (map (pPrint . PP) xs)) -- |Show just the top line of a changelog entry (for debugging output.) _showHeader :: ChangeLogEntry -> Doc _showHeader (Entry package ver dists urgency _ _ _) = text (package <> " (") <> prettyDebianVersion ver <> text (") " <> intercalate " " (map releaseName' dists) <> "; urgency=" <> urgency <> "...") _showHeader (WhiteSpace _) = error "_showHeader" {- format is a series of entries like this: package (version) distribution(s); urgency=urgency [optional blank line(s), stripped] * change details more change details [blank line(s), included in output of dpkg-parsechangelog] * even more change details [optional blank line(s), stripped] -- maintainer name [two spaces] date package and version are the source package name and version number. distribution(s) lists the distributions where this version should be installed when it is uploaded - it is copied to the Distribution field in the .changes file. See Distribution, Section 5.6.14. urgency is the value for the Urgency field in the .changes file for the upload (see Urgency, Section 5.6.17). It is not possible to specify an urgency containing commas; commas are used to separate keyword=value settings in the dpkg changelog format (though there is currently only one useful keyword, urgency). The change details may in fact be any series of lines starting with at least two spaces, but conventionally each change starts with an asterisk and a separating space and continuation lines are indented so as to bring them in line with the start of the text above. Blank lines may be used here to separate groups of changes, if desired. If this upload resolves bugs recorded in the Bug Tracking System (BTS), they may be automatically closed on the inclusion of this package into the Debian archive by including the string: closes: Bug#nnnnn in the change details.[16] This information is conveyed via the Closes field in the .changes file (see Closes, Section 5.6.22). The maintainer name and email address used in the changelog should be the details of the person uploading this version. They are not necessarily those of the usual package maintainer. The information here will be copied to the Changed-By field in the .changes file (see Changed-By, Section 5.6.4), and then later used to send an acknowledgement when the upload has been installed. The date must be in RFC822 format[17]; it must include the time zone specified numerically, with the time zone name or abbreviation optionally present as a comment in parentheses. The first "title" line with the package name must start at the left hand margin. The "trailer" line with the maintainer and date details must be preceded by exactly one space. The maintainer details and the date must be separated by exactly two spaces. The entire changelog must be encoded in UTF-8. -} -- | Parse the entries of a debian changelog and verify they are all -- valid. parseChangeLog :: String -> ChangeLog parseChangeLog s = case partitionEithers (parseEntries s) of ([], xs) -> ChangeLog xs (ss, _) -> error (intercalate "\n " ("Error(s) parsing changelog:" : concat ss)) -- |Parse a Debian Changelog and return a lazy list of entries parseEntries :: String -> [Either [String] ChangeLogEntry] parseEntries "" = [] parseEntries text = case parseEntry text of Left messages -> [Left messages] Right (entry, text') -> Right entry : parseEntries text' -- |Parse a single changelog entry, returning the entry and the remaining text. {- parseEntry :: String -> Failing (ChangeLogEntry, String) parseEntry text = case span (\ x -> elem x " \t\n") text of ("", _) -> case matchRegexAll entryRE text of Nothing -> Failure ["Parse error in changelog:\n" ++ show text] Just ("", _, remaining, [_, name, version, dists, urgency, _, details, _, _, _, _, _, who, date, _]) -> Success (Entry name (parseDebianVersion version) (map parseReleaseName . words $ dists) urgency details who date, remaining) Just (before, _, remaining, submatches) -> Failure ["Internal error:\n text=" ++ show text ++ "\n before=" ++ show before ++ "\n remaining=" ++ show remaining ++ ", submatches=" ++ show submatches] (w, text') -> Success (WhiteSpace (trace ("whitespace: " ++ show w) w), text') -} parseEntry :: String -> Either [String] (ChangeLogEntry, String) parseEntry text = case text =~ entryRE :: MatchResult String of x | mrSubList x == [] -> Left ["Parse error in " ++ show text] MR {mrAfter = after, mrSubList = [_, name, ver, dists, urgency, _, details, _, _, who, _, date, _]} -> Right (Entry name (parseDebianVersion ver) (map parseReleaseName . words $ dists) urgency (" " ++ unpack (strip (pack details)) ++ "\n") (take (length who - 2) who) date, after) MR {mrBefore = _before, mrMatch = _matched, mrAfter = after, mrSubList = matches} -> Left ["Internal error\n after=" ++ show after ++ "\n " ++ show (length matches) ++ " matches: " ++ show matches] {- parseREs :: [Regex] -> String -> Failing ([String], String) parseREs res text = foldr f (Success ([], text)) entryREs where f _ (Failure msgs) = Failure msgs f re (Success (oldMatches, text)) = case matchRegexAll re text of Nothing -> Failure ["Parse error at " ++ show text] Just (before, matched, after, newMatches) -> Success (oldMatches ++ trace ("newMatches=" ++ show newMatches) newMatches, after) -} entryRE = bol ++ blankLines ++ headerRE ++ changeDetails ++ signature ++ blankLines changeDetails = "((\n| \n| -\n|([^ ]| [^--]| -[^--])[^\n]*\n)*)" signature = " -- ([ ]*([^ ]+ )* )([^\n]*)\n" {- entryRE = mkRegexWithOpts (bol ++ blankLines ++ headerRE ++ nonSigLines ++ blankLines ++ signature ++ blankLines) False True nonSigLines = "((( .*|\t.*| \t.*)|([ \t]*)\n)+)" -- In the debian repository, sometimes the extra space in front of the -- day-of-month is missing, sometimes an extra one is added. signature = "( -- ([^\n]*) (..., ? ?.. ... .... ........ .....))[ \t]*\n" -} -- |Parse the changelog information that shows up in the .changes -- file, i.e. a changelog entry with no signature. parseChanges :: Text -> Maybe ChangeLogEntry parseChanges text = case unpack text =~ changesRE :: MatchResult String of MR {mrSubList = []} -> Nothing MR {mrSubList = [_, name, ver, dists, urgency, _, details]} -> Just $ Entry name (parseDebianVersion ver) (map parseReleaseName . words $ dists) urgency details "" "" MR {mrSubList = x} -> error $ "Unexpected match: " ++ show x where changesRE = bol ++ blankLines ++ optWhite ++ headerRE ++ "(.*)$" headerRE = package ++ ver ++ dists ++ urgency where package = "([^ \t(]*)" ++ optWhite ver = "\\(([^)]*)\\)" ++ optWhite dists = "([^;]*);" ++ optWhite urgency = "urgency=([^\n]*)\n" ++ blankLines blankLines = blankLine ++ "*" blankLine = "(" ++ optWhite ++ "\n)" optWhite = "[ \t]*" bol = "^" -- This can be used for tests _s1 = unlines ["haskell-regex-compat (0.92-3+seereason1~jaunty4) jaunty-seereason; urgency=low", "", " [ Joachim Breitner ]", " * Adjust priority according to override file", " * Depend on hscolour (Closes: #550769)", "", " [ Marco Túlio Gontijo e Silva ]", " * debian/control: Use more sintetic name for Vcs-Darcs.", " * Built from sid apt pool", " * Build dependency changes:", " cpphs: 1.9-1+seereason1~jaunty5 -> 1.9-1+seereason1~jaunty6", " ghc6: 6.10.4-1+seereason5~jaunty1 -> 6.12.1-0+seereason1~jaunty1", " ghc6-doc: 6.10.4-1+seereason5~jaunty1 -> 6.12.1-0+seereason1~jaunty1", " ghc6-prof: 6.10.4-1+seereason5~jaunty1 -> 6.12.1-0+seereason1~jaunty1", " haddock: 2.4.2-3+seereason3~jaunty1 -> 6.12.1-0+seereason1~jaunty1", " haskell-devscripts: 0.6.18-21+seereason1~jaunty1 -> 0.6.18-23+seereason1~jaunty1", " haskell-regex-base-doc: 0.93.1-5+seereason1~jaunty1 -> 0.93.1-5++1+seereason1~jaunty1", " haskell-regex-posix-doc: 0.93.2-4+seereason1~jaunty1 -> 0.93.2-4+seereason1~jaunty2", " libghc6-regex-base-dev: 0.93.1-5+seereason1~jaunty1 -> 0.93.1-5++1+seereason1~jaunty1", " libghc6-regex-base-prof: 0.93.1-5+seereason1~jaunty1 -> 0.93.1-5++1+seereason1~jaunty1", " libghc6-regex-posix-dev: 0.93.2-4+seereason1~jaunty1 -> 0.93.2-4+seereason1~jaunty2", " libghc6-regex-posix-prof: 0.93.2-4+seereason1~jaunty1 -> 0.93.2-4+seereason1~jaunty2", "", " -- SeeReason Autobuilder Fri, 25 Dec 2009 01:55:37 -0800", "", "haskell-regex-compat (0.92-3) unstable; urgency=low", "", " [ Joachim Breitner ]", " * Adjust priority according to override file", " * Depend on hscolour (Closes: #550769)", "", " [ Marco Túlio Gontijo e Silva ]", " * debian/control: Use more sintetic name for Vcs-Darcs.", "", " -- Joachim Breitner Mon, 20 Jul 2009 13:05:35 +0200", "", "haskell-regex-compat (0.92-2) unstable; urgency=low", "", " * Adopt package for the Debian Haskell Group", " * Fix \"FTBFS with new dpkg-dev\" by adding comma to debian/control", " (Closes: #536473)", "", " -- Joachim Breitner Mon, 20 Jul 2009 12:05:40 +0200", "", "haskell-regex-compat (0.92-1.1) unstable; urgency=low", "", " * Rebuild for GHC 6.10.", " * NMU with permission of the author.", "", " -- John Goerzen Mon, 16 Mar 2009 10:12:04 -0500", "", "haskell-regex-compat (0.92-1) unstable; urgency=low", "", " * New upstream release", " * debian/control:", " - Bump Standards-Version. No changes needed.", "", " -- Arjan Oosting Sun, 18 Jan 2009 00:05:02 +0100", "", "haskell-regex-compat (0.91-1) unstable; urgency=low", "", " * Take over package from Ian, as I already maintain haskell-regex-base,", " and move Ian to the Uploaders field.", " * Packaging complete redone (based on my haskell-regex-base package).", "", " -- Arjan Oosting Sat, 19 Jan 2008 16:48:39 +0100", "", "haskell-regex-compat (0.71.0.1-1) unstable; urgency=low", " ", " * Initial release (used to be part of ghc6).", " * Using \"Generic Haskell cabal library packaging files v9\".", " ", " -- Ian Lynagh (wibble) Wed, 21 Nov 2007 01:26:57 +0000"] cabal-debian-4.31/debian-haskell/Debian/Report.hs0000644000000000000000000001004112565162075017752 0ustar0000000000000000module Debian.Report where import Data.Maybe import qualified Data.Map as M import Data.Text as Text (Text, unpack) import Debian.Apt.Index (Fetcher, Compression(..), update, controlFromIndex') import Debian.Control.Text import Debian.Sources import Debian.Version import Text.XML.HaXml (CFilter, mkElem, cdata) import Text.XML.HaXml.Posn import Text.PrettyPrint (render) -- * General Package Map Builders -- |create a map of (package name, extracted field) from a list of index files -- -- NOTE: we could merge all the files into a single control and then -- run packageMap over that. We currently do it one control file at a -- time to avoid having all the control files loaded in memory at -- once. However, I am not sure that property is actually occuring -- anyway. So, this should be revisited. makePackageMap :: (Paragraph -> a) -> (a -> a -> a) -> [(FilePath, Compression)] -> IO (M.Map Text a) makePackageMap _ _ [] = return M.empty makePackageMap extractValue resolveConflict ((path, compression):is) = do r <- controlFromIndex' compression path case r of (Left e) -> error (show e) (Right c) -> do let pm = packageMap extractValue resolveConflict c pms <- makePackageMap extractValue resolveConflict is return $ M.unionWith resolveConflict pm pms -- |create a map of (package name, max version) from a single control file packageMap :: (Paragraph -> a) -> (a -> a -> a) -> Control' Text -> M.Map Text a packageMap extractValue resolveConflict control = M.fromListWith resolveConflict (map packageTuple (unControl control)) where packageTuple paragraph = (fromJust $ fieldValue "Package" paragraph, extractValue paragraph) -- |extract the version number from a control paragraph extractVersion :: Paragraph -> Maybe DebianVersion extractVersion paragraph = fmap (parseDebianVersion . unpack) $ fieldValue "Version" paragraph -- * Trump Report -- |compare two sources.list and find all the packages in the second that trump packages in the first -- see also: |trumpedMap| trumped :: Fetcher -- ^ function for downloading package indexes -> FilePath -- ^ cache directory to store index files in (must already exist) -> String -- ^ binary architecture -> [DebSource] -- ^ sources.list a -> [DebSource] -- ^ sources.list b -> IO (M.Map Text (DebianVersion, DebianVersion)) -- ^ a map of trumped package names to (version a, version b) trumped fetcher cacheDir arch sourcesA sourcesB = do indexesA <- update fetcher cacheDir arch (filter isDebSrc sourcesA) pmA <- makePackageMap (fromJust . extractVersion) max (map fromJust indexesA) indexesB <- update fetcher cacheDir arch (filter isDebSrc sourcesB) pmB <- makePackageMap (fromJust . extractVersion) max (map fromJust indexesB) return (trumpedMap pmA pmB) where isDebSrc ds = sourceType ds == DebSrc -- |calculate all the trumped packages trumpedMap :: M.Map Text DebianVersion -- ^ package map a -> M.Map Text DebianVersion -- ^ package map b -> M.Map Text (DebianVersion, DebianVersion) -- ^ trumped packages (version a, version b) trumpedMap pmA pmB = M.foldWithKey (checkTrumped pmB) M.empty pmA where checkTrumped pm package aVersion trumpedPM = case M.lookup package pm of (Just bVersion) | bVersion > aVersion -> M.insert package (aVersion, bVersion) trumpedPM _ -> trumpedPM -- |create XML element and children from a trumped Map trumpedXML :: M.Map Text (DebianVersion, DebianVersion) -> CFilter Posn trumpedXML trumpedMap' = mkElem "trumped" (map mkTrumpedPackage (M.toAscList trumpedMap' )) where mkTrumpedPackage (package, (oldVersion, newVersion)) = mkElem "trumpedPackage" [ mkElem "package" [ cdata (unpack package) ] , mkElem "oldVersion" [ cdata (render . prettyDebianVersion $ oldVersion) ] , mkElem "newVersion" [ cdata (render . prettyDebianVersion $ newVersion) ] ] cabal-debian-4.31/debian-haskell/Debian/Relation.hs0000644000000000000000000000125512565162075020263 0ustar0000000000000000-- |A module for working with debian relationships module Debian.Relation ( -- * Types PkgName(..) , SrcPkgName(..) , BinPkgName(..) , Relations , AndRelation , OrRelation , Relation(..) , ArchitectureReq(..) , Arch(..) , ArchOS(..) , ArchCPU(..) , VersionReq(..) -- * Helper Functions , checkVersionReq -- * Relation Parser , RelParser , ParseRelations(..) ) where import Debian.Arch (Arch(..), ArchOS(..), ArchCPU(..)) import Debian.Relation.Common (SrcPkgName(..), BinPkgName(..), PkgName(pkgNameFromString)) import Debian.Relation.String cabal-debian-4.31/debian-haskell/Debian/Time.hs0000644000000000000000000000145312565162075017404 0ustar0000000000000000{-# LANGUAGE CPP #-} module Debian.Time where import Data.Time #if !MIN_VERSION_time(1,5,0) import System.Locale (defaultTimeLocale) #endif import Data.Time.Clock.POSIX import System.Posix.Types -- * Time Helper Functions rfc822DateFormat' :: String rfc822DateFormat' = "%a, %d %b %Y %T %z" epochTimeToUTCTime :: EpochTime -> UTCTime epochTimeToUTCTime = posixSecondsToUTCTime . fromIntegral . fromEnum formatTimeRFC822 :: (FormatTime t) => t -> String formatTimeRFC822 = formatTime defaultTimeLocale rfc822DateFormat' parseTimeRFC822 :: (ParseTime t) => String -> Maybe t parseTimeRFC822 = parseTime defaultTimeLocale rfc822DateFormat' getCurrentLocalRFC822Time :: IO String getCurrentLocalRFC822Time = getCurrentTime >>= utcToLocalZonedTime >>= return . formatTime defaultTimeLocale rfc822DateFormat' cabal-debian-4.31/debian-haskell/Debian/URI.hs0000644000000000000000000000675212565162075017154 0ustar0000000000000000{-# LANGUAGE PackageImports #-} {-# OPTIONS -fno-warn-orphans #-} module Debian.URI ( module Network.URI , URI' , toURI' , fromURI' , readURI' , uriToString' , fileFromURI , fileFromURIStrict , dirFromURI ) where import Control.Exception (SomeException, try) import Data.ByteString.Lazy.UTF8 as L import qualified Data.ByteString.Lazy.Char8 as L import Data.Maybe (catMaybes, fromJust) import Network.URI (URI(..), URIAuth(..), parseURI, uriToString) import System.Directory (getDirectoryContents) -- import System.Process.ByteString (readProcessWithExitCode) import System.Process.ByteString.Lazy (readProcessWithExitCode) import Text.Regex (mkRegex, matchRegex) -- | A wrapper around a String containing a known parsable URI. Not -- absolutely safe, because you could say read "URI' \"bogus string\"" -- :: URI'. But enough to save me from myself. newtype URI' = URI' String deriving (Read, Show, Eq, Ord) readURI' :: String -> Maybe URI' readURI' s = maybe Nothing (const (Just (URI' s))) (parseURI s) fromURI' :: URI' -> URI fromURI' (URI' s) = fromJust (parseURI s) -- | Using the bogus Show instance of URI here. If it ever gets fixed -- this will stop working. Worth noting that show will obscure any -- password info embedded in the URI, so that's nice. toURI' :: URI -> URI' toURI' = URI' . show uriToString' :: URI -> String uriToString' uri = uriToString id uri "" fileFromURI :: URI -> IO (Either SomeException L.ByteString) fileFromURI uri = fileFromURIStrict uri fileFromURIStrict :: URI -> IO (Either SomeException L.ByteString) fileFromURIStrict uri = try $ case (uriScheme uri, uriAuthority uri) of ("file:", Nothing) -> L.readFile (uriPath uri) -- ("ssh:", Just auth) -> cmdOutputStrict ("ssh " ++ uriUserInfo auth ++ uriRegName auth ++ uriPort auth ++ " cat " ++ show (uriPath uri)) ("ssh:", Just auth) -> do let cmd = "ssh" args = [uriUserInfo auth ++ uriRegName auth ++ uriPort auth, "cat", uriPath uri] (_code, out, _err) <- readProcessWithExitCode cmd args L.empty return out _ -> do let cmd = "curl" args = ["-s", "-g", uriToString' uri] (_code, out, _err) <- readProcessWithExitCode cmd args L.empty return out -- | Parse the text returned when a directory is listed by a web -- server. This is currently only known to work with Apache. -- NOTE: there is a second copy of this function in -- Extra:Extra.Net. Please update both locations if you make changes. webServerDirectoryContents :: L.ByteString -> [String] webServerDirectoryContents text = catMaybes . map (second . matchRegex re) . Prelude.lines . L.toString $ text where re = mkRegex "( IO (Either SomeException [String]) dirFromURI uri = try $ case (uriScheme uri, uriAuthority uri) of ("file:", Nothing) -> getDirectoryContents (uriPath uri) ("ssh:", Just auth) -> do let cmd = "ssh" args = [uriUserInfo auth ++ uriRegName auth ++ uriPort auth, "ls", "-1", uriPath uri] (_code, out, _err) <- readProcessWithExitCode cmd args L.empty return . Prelude.lines . L.toString $ out _ -> do let cmd = "curl" args = ["-s", "-g", uriToString' uri] (_code, out, _err) <- readProcessWithExitCode cmd args L.empty return . webServerDirectoryContents $ out cabal-debian-4.31/debian-haskell/Debian/Version.hs0000644000000000000000000000074712565162075020140 0ustar0000000000000000-- |A module for parsing, comparing, and (eventually) modifying debian version -- numbers. module Debian.Version (DebianVersion -- |Exported abstract because the internal representation is likely to change , prettyDebianVersion , parseDebianVersion , epoch , version , revision , buildDebianVersion , evr ) where import Debian.Version.Common import Debian.Version.String () cabal-debian-4.31/debian-haskell/Debian/Arch.hs0000644000000000000000000000262212565162075017362 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-} module Debian.Arch ( Arch(..) , ArchOS(..) , ArchCPU(..) , prettyArch , parseArch ) where import Data.Data (Data) import Data.Monoid ((<>)) import Data.Typeable (Typeable) import Text.PrettyPrint (Doc, text) data ArchOS = ArchOS String | ArchOSAny deriving (Eq, Ord, Read, Show, Data, Typeable) prettyOS :: ArchOS -> Doc prettyOS (ArchOS s) = text s prettyOS ArchOSAny = text "any" parseOS :: String -> ArchOS parseOS "any" = ArchOSAny parseOS s = ArchOS s data ArchCPU = ArchCPU String | ArchCPUAny deriving (Eq, Ord, Read, Show, Data, Typeable) prettyCPU :: ArchCPU -> Doc prettyCPU (ArchCPU s) = text s prettyCPU ArchCPUAny = text "any" parseCPU :: String -> ArchCPU parseCPU "any" = ArchCPUAny parseCPU s = ArchCPU s data Arch = Source | All | Binary ArchOS ArchCPU deriving (Eq, Ord, Read, Show, Data, Typeable) prettyArch :: Arch -> Doc prettyArch Source = text "source" prettyArch All = text "all" prettyArch (Binary (ArchOS "linux") cpu) = prettyCPU cpu prettyArch (Binary os cpu) = prettyOS os <> text "-" <> prettyCPU cpu parseArch :: String -> Arch parseArch s = case span (/= '-') s of ("source", "") -> Source ("all", "") -> All (cpu, "") -> Binary (ArchOS "linux") (parseCPU cpu) (os, '-' : cpu) -> Binary (parseOS os) (parseCPU cpu) _ -> error "parseArch: internal error" cabal-debian-4.31/debian-haskell/Debian/Deb.hs0000644000000000000000000000226612565162075017203 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-name-shadowing #-} module Debian.Deb where import Control.Monad import Debian.Control.Common import System.Directory (canonicalizePath) import System.Exit (ExitCode(..)) import System.Process (readProcessWithExitCode) import System.Unix.Directory (withTemporaryDirectory, withWorkingDirectory) fields :: (ControlFunctions a) => FilePath -> IO (Control' a) fields debFP = withTemporaryDirectory ("fields.XXXXXX") $ \tmpdir -> do debFP <- canonicalizePath debFP withWorkingDirectory tmpdir $ do (res, out, err) <- readProcessWithExitCode "ar" ["x",debFP,"control.tar.gz"] "" when (res /= ExitSuccess) (error $ "Dpkg.fields: " ++ show out ++ "\n" ++ show err ++ "\n" ++ show res) (res, out, err) <- readProcessWithExitCode "tar" ["xzf", "control.tar.gz", "./control"] "" when (res /= ExitSuccess) (error $ "Dpkg.fields: " ++ show out ++ "\n" ++ show err ++ "\n" ++ show res) c <- parseControlFromFile "control" case c of Left e -> error (show e) (Right c) -> return c -- I don't think we need seq because parsec will force everything from the file cabal-debian-4.31/debian-haskell/Debian/Release.hs0000644000000000000000000000412312565162075020063 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} module Debian.Release ( ReleaseName(..) , parseReleaseName , releaseName' , Section(..) , SubSection(..) , sectionName , sectionName' , sectionNameOfSubSection , parseSection , parseSection' ) where import Data.Data (Data) import Data.Typeable (Typeable) import Network.URI (unEscapeString, escapeURIString, isAllowedInURI) -- |A distribution (aka release) name. This type is expected to refer -- to a subdirectory of the dists directory which is at the top level -- of a repository. data ReleaseName = ReleaseName { relName :: String } deriving (Eq, Ord, Read, Show, Data, Typeable) parseReleaseName :: String -> ReleaseName parseReleaseName name = ReleaseName {relName = unEscapeString name} releaseName' :: ReleaseName -> String releaseName' (ReleaseName {relName = s}) = escapeURIString isAllowedInURI s -- |A section of a repository such as main, contrib, non-free, -- restricted. The indexes for a section are located below the -- distribution directory. newtype Section = Section String deriving (Read, Show, Eq, Ord) -- |A package's subsection is only evident in its control information, -- packages from different subsections all reside in the same index. data SubSection = SubSection { section :: Section, subSectionName :: String } deriving (Read, Show, Eq, Ord) sectionName :: SubSection -> String sectionName (SubSection (Section "main") y) = y sectionName (SubSection x y) = sectionName' x ++ "/" ++ y sectionName' :: Section -> String sectionName' (Section s) = escapeURIString isAllowedInURI s sectionNameOfSubSection :: SubSection -> String sectionNameOfSubSection = sectionName' . section -- |Parse the value that appears in the @Section@ field of a .changes file. -- (Does this need to be unesacped?) parseSection :: String -> SubSection parseSection s = case span (/= '/') s of (x, "") -> SubSection (Section "main") x ("main", y) -> SubSection (Section "main") y (x, y) -> SubSection (Section x) (tail y) parseSection' :: String -> Section parseSection' name = Section (unEscapeString name) cabal-debian-4.31/debian-haskell/Debian/Pretty.hs0000644000000000000000000000253412565162075017776 0ustar0000000000000000-- | A constructor we can wrap around values to avoid any built in -- Pretty instance - for example, instance Pretty [a]. -- -- * display is now prettyShow -- * display' is now prettyText -- * ppDisplay is now ppShow -- * ppDisplay' is now ppText {-# LANGUAGE DeriveFunctor, FlexibleContexts, FlexibleInstances, OverloadedStrings, TypeSynonymInstances #-} module Debian.Pretty ( PP(PP, unPP) , prettyShow , prettyText , ppPrint , ppShow , ppText ) where import Data.Text (Text, unpack, pack) import Text.PrettyPrint.HughesPJClass (Doc, Pretty(pPrint), text, empty, prettyShow) -- | This type is wrapped around values before we pretty print them so -- we can write our own Pretty instances for common types without -- polluting the name space of clients of this package with instances -- they don't want. newtype PP a = PP {unPP :: a} deriving (Functor) instance Pretty (PP Text) where pPrint = text . unpack . unPP instance Pretty (PP String) where pPrint = text . unPP instance Pretty (PP a) => Pretty (PP (Maybe a)) where pPrint = maybe empty ppPrint . unPP prettyText :: Pretty a => a -> Text prettyText = pack . prettyShow ppPrint :: Pretty (PP a) => a -> Doc ppPrint = pPrint . PP ppShow :: Pretty (PP a) => a -> String ppShow = prettyShow . PP ppText :: Pretty (PP a) => a -> Text ppText = pack . prettyShow . PP cabal-debian-4.31/debian-haskell/Debian/Sources.hs0000644000000000000000000001604312565162075020132 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} module Debian.Sources where import Data.List (intercalate) import Data.Monoid ((<>)) import Debian.Pretty (PP(..)) import Debian.Release import Network.URI (URI, uriToString, parseURI, unEscapeString, escapeURIString, isAllowedInURI) import Text.PrettyPrint (text, hcat) import Text.PrettyPrint.HughesPJClass (Pretty(pPrint)) data SourceType = Deb | DebSrc deriving (Eq, Ord, Show) data DebSource = DebSource { sourceType :: SourceType , sourceUri :: URI , sourceDist :: Either String (ReleaseName, [Section]) } deriving (Eq, Ord, Show) instance Pretty SourceType where pPrint Deb = text "deb" pPrint DebSrc = text "deb-src" instance Pretty DebSource where pPrint (DebSource thetype theuri thedist) = pPrint thetype <> text (" " <> uriToString id theuri " " <> case thedist of Left exactPath -> escape exactPath Right (dist, sections) -> releaseName' dist <> " " <> intercalate " " (map sectionName' sections)) where escape = escapeURIString isAllowedInURI instance Pretty (PP [DebSource]) where pPrint = hcat . map (\ x -> pPrint x <> text "\n") . unPP -- |This is a name given to a combination of parts of one or more -- releases that can be specified by a sources.list file. type SliceName = ReleaseName -- data SliceName = SliceName { sliceName :: String } deriving (Eq, Ord, Show) {- deb uri distribution [component1] [componenent2] [...] The URI for the deb type must specify the base of the Debian distribution, from which APT will find the information it needs. distribution can specify an exact path, in which case the components must be omitted and distribution must end with a slash (/). If distribution does not specify an exact path, at least one component must be present. Distribution may also contain a variable, $(ARCH), which expands to the Debian architecture (i386, m68k, powerpc, ...) used on the system. The rest of the line can be marked as a comment by using a #. Additional Notes: + Lines can begin with leading white space. + If the dist ends with slash (/), then it must be an absolute path and it is an error to specify components after it. -} -- |quoteWords - similar to words, but with special handling of -- double-quotes and brackets. -- -- The handling double quotes and [] is supposed to match: -- apt-0.6.44.2\/apt-pkg\/contrib\/strutl.cc:ParseQuoteWord() -- -- The behaviour can be defined as: -- -- Break the string into space seperated words ignoring spaces that -- appear between \"\" or []. Strip trailing and leading white space -- around words. Strip out double quotes, but leave the square -- brackets intact. quoteWords :: String -> [String] quoteWords [] = [] quoteWords s = quoteWords' (dropWhile (==' ') s) where quoteWords' :: String -> [String] quoteWords' [] = [] quoteWords' str = case break (flip elem (" [\"" :: String)) str of ([],[]) -> [] (w, []) -> [w] (w, (' ':rest)) -> w : (quoteWords' (dropWhile (==' ') rest)) (w, ('"':rest)) -> case break (== '"') rest of (w',('"':rest)) -> case quoteWords' rest of [] -> [w ++ w'] (w'':ws) -> ((w ++ w' ++ w''): ws) (_w',[]) -> error ("quoteWords: missing \" in the string: " ++ s) _ -> error ("the impossible happened in SourcesList.quoteWords") (w, ('[':rest)) -> case break (== ']') rest of (w',(']':rest)) -> case quoteWords' rest of [] -> [w ++ "[" ++ w' ++ "]"] (w'':ws) -> ((w ++ "[" ++ w' ++ "]" ++ w''): ws) (_w',[]) -> error ("quoteWords: missing ] in the string: " ++ s) _ -> error ("the impossible happened in SourcesList.quoteWords") _ -> error ("the impossible happened in SourcesList.quoteWords") stripLine :: String -> String stripLine = takeWhile (/= '#') . dropWhile (== ' ') sourceLines :: String -> [String] sourceLines = filter (not . null) . map stripLine . lines -- |parseSourceLine -- parses a source line -- the argument must be a non-empty, valid source line with comments stripped -- see: 'sourceLines' parseSourceLine :: String -> DebSource parseSourceLine str = case quoteWords str of (theTypeStr : theUriStr : theDistStr : sectionStrs) -> let sections = map parseSection' sectionStrs theType = case unEscapeString theTypeStr of "deb" -> Deb "deb-src" -> DebSrc o -> error ("parseSourceLine: invalid type " ++ o ++ " in line:\n" ++ str) theUri = case parseURI theUriStr of Nothing -> error ("parseSourceLine: invalid uri " ++ theUriStr ++ " in the line:\n" ++ str) Just u -> u theDist = unEscapeString theDistStr in case last theDist of '/' -> if null sections then DebSource { sourceType = theType, sourceUri = theUri, sourceDist = Left theDist } else error ("parseSourceLine: Dist is an exact path, so sections are not allowed on the line:\n" ++ str) _ -> if null sections then error ("parseSourceLine: Dist is not an exact path, so at least one section is required on the line:\n" ++ str) else DebSource { sourceType = theType, sourceUri = theUri, sourceDist = Right (parseReleaseName theDist, sections) } _ -> error ("parseSourceLine: invalid line in sources.list:\n" ++ str) parseSourceLine' :: String -> Maybe DebSource parseSourceLine' str = case quoteWords str of (theTypeStr : theUriStr : theDistStr : sectionStrs) -> let sections = map parseSection' sectionStrs theType = case unEscapeString theTypeStr of "deb" -> Just Deb "deb-src" -> Just DebSrc _ -> Nothing theUri = case parseURI theUriStr of Nothing -> Nothing Just u -> Just u theDist = unEscapeString theDistStr in case (last theDist, theType, theUri) of ('/', Just typ, Just uri) -> if null sections then Just $ DebSource { sourceType = typ, sourceUri = uri, sourceDist = Left theDist } else error ("parseSourceLine: Dist is an exact path, so sections are not allowed on the line:\n" ++ str) (_, Just typ, Just uri) -> if null sections then Nothing else Just $ DebSource { sourceType = typ, sourceUri = uri, sourceDist = Right ((parseReleaseName theDist), sections) } _ -> Nothing _ -> Nothing parseSourcesList :: String -> [DebSource] parseSourcesList = map parseSourceLine . sourceLines cabal-debian-4.31/debian-haskell/Debian/Control.hs0000644000000000000000000000422212565162075020123 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- |A module for working with Debian control files module Debian.Control ( -- * Types Control'(..) , Paragraph'(..) , Field'(..) , Control , Paragraph , Field , ControlParser , ControlFunctions(..) -- * Control File Parser , pControl -- * Helper Functions , mergeControls , fieldValue , removeField , prependFields , appendFields , renameField , modifyField , raiseFields , packParagraph , packField , formatControl , formatParagraph , formatField -- * Policy classes and functions , P.HasDebianControl(..) , P.ControlFileError(..) , P.parseDebianControlFromFile , P.validateDebianControl , P.unsafeDebianControl , P.debianSourceParagraph , P.debianBinaryParagraphs , P.debianPackageParagraphs , P.debianPackageNames , P.debianSourcePackageName , P.debianBinaryPackageNames , P.debianRelations , P.debianBuildDeps , P.debianBuildDepsIndep ) where --import Control.Monad --import Data.List --import Text.ParserCombinators.Parsec --import System.IO import Debian.Control.Common import Debian.Control.String import Data.List import Data.Text as T (Text, pack, concat) import qualified Debian.Control.Text as T import qualified Debian.Control.ByteString as B () import qualified Debian.Control.Policy as P import qualified Debian.Control.String as S packParagraph :: S.Paragraph -> T.Paragraph packParagraph (S.Paragraph s) = T.Paragraph (map packField s) packField :: Field' String -> Field' Text packField (S.Field (name, value)) = T.Field (T.pack name, T.pack value) packField (S.Comment s) = T.Comment (T.pack s) formatControl :: Control' Text -> [Text] formatControl (T.Control paragraphs) = intersperse (T.pack "\n") . map formatParagraph $ paragraphs formatParagraph :: Paragraph' Text -> Text formatParagraph (T.Paragraph fields) = T.concat . map formatField $ fields formatField :: Field' Text -> Text formatField (T.Field (name, value)) = T.concat [name, T.pack ":", value, T.pack "\n"] formatField (T.Comment s) = s cabal-debian-4.31/debian-haskell/Debian/GenBuildDeps.hs0000644000000000000000000003207612565162075021020 0ustar0000000000000000{-# LANGUAGE CPP, FlexibleContexts, OverloadedStrings, RecordWildCards, ScopedTypeVariables, TemplateHaskell #-} -- |Figure out the dependency relation between debianized source -- directories. The code to actually solve these dependency relations -- for a particular set of binary packages is in Debian.Repo.Dependency. module Debian.GenBuildDeps ( DepInfo(..) , sourceName' , relations' , binaryNames' -- * Preparing dependency info , buildDependencies , RelaxInfo , relaxDeps -- * Using dependency info , BuildableInfo(..) , ReadyTarget(..) , buildable , compareSource -- * Obsolete? , orderSource , genDeps , failPackage , getSourceOrder ) where #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif import Control.Exception (throw) import Control.Monad (filterM) import Data.Graph (Graph, Edge, Vertex, buildG, topSort, reachable, transposeG, edges, scc) import Data.List import qualified Data.Map as Map import Data.Maybe import qualified Data.Set as Set import Data.Tree as Tree (Tree(Node, rootLabel, subForest)) import Debian.Control (parseControlFromFile) import Debian.Control.Policy (HasDebianControl, DebianControl, ControlFileError(..), validateDebianControl, debianSourcePackageName, debianBinaryPackageNames, debianBuildDeps, debianBuildDepsIndep) import Debian.Loc (__LOC__) import Debian.Relation import Debian.Relation.Text () import System.Directory (getDirectoryContents, doesFileExist) -- | This type describes the build dependencies of a source package. data DepInfo = DepInfo { sourceName :: SrcPkgName -- ^ source package name , relations :: Relations -- ^ dependency relations , binaryNames :: [BinPkgName] -- ^ binary dependency names (is this a function of relations?) } deriving Show instance Eq DepInfo where a == b = (sourceName a == sourceName b) && Set.fromList (map Set.fromList (relations a)) == Set.fromList (map Set.fromList (relations b)) && Set.fromList (binaryNames a) == Set.fromList (binaryNames b) -- |Return the dependency info for a source package with the given dependency relaxation. -- |According to debian policy, only the first paragraph in debian\/control can be a source package -- buildDependencies :: HasDebianControl control => control -> DepInfo buildDependencies control = do DepInfo { sourceName = debianSourcePackageName control , relations = concat [fromMaybe [] (debianBuildDeps control), fromMaybe [] (debianBuildDepsIndep control)] , binaryNames = debianBinaryPackageNames control } -- | source package name sourceName' :: HasDebianControl control => control -> SrcPkgName sourceName' control = debianSourcePackageName control -- | dependency relations relations' :: HasDebianControl control => control -> Relations relations' control = concat [fromMaybe [] (debianBuildDeps control), fromMaybe [] (debianBuildDepsIndep control)] -- | binary dependency names (is this a function of relations?) binaryNames' :: HasDebianControl control => control -> [BinPkgName] binaryNames' control = debianBinaryPackageNames control -- |Specifies build dependencies that should be ignored during the build -- decision. If the pair is (BINARY, Nothing) it means the binary package -- BINARY should always be ignored when deciding whether to build. If the -- pair is (BINARY, Just SOURCE) it means that binary package BINARY should -- be ignored when deiciding whether to build package SOURCE. newtype OldRelaxInfo = RelaxInfo [(BinPkgName, Maybe SrcPkgName)] deriving Show -- | Given a source package name and a binary package name, return -- False if the binary package should be ignored hwen deciding whether -- to build the source package. This is used to prevent build -- dependency cycles from triggering unnecessary rebuilds. (This is a -- replacement for the RelaxInfo type, which we temporarily rename -- OldRelaxInfo.) type RelaxInfo = SrcPkgName -> BinPkgName -> Bool -- |Remove any dependencies that are designated \"relaxed\" by relaxInfo. relaxDeps :: RelaxInfo -> [DepInfo] -> [DepInfo] relaxDeps relaxInfo deps = map relaxDep deps where relaxDep :: DepInfo -> DepInfo relaxDep info = info {relations = filteredDependencies} where -- Discard any dependencies not on the filtered package name list. If -- this results in an empty list in an or-dep the entire dependency can -- be discarded. filteredDependencies :: Relations filteredDependencies = filter (/= []) (map (filter keepDep) (relations info)) keepDep :: Relation -> Bool keepDep (Rel name _ _) = not (relaxInfo (sourceName info) name) data ReadyTarget a = ReadyTarget { ready :: a -- ^ Some target whose build dependencies are all satisfied , waiting :: [a] -- ^ The targets that are waiting for the ready target , other :: [a] -- ^ The rest of the targets that need to be built } data BuildableInfo a = BuildableInfo { readyTargets :: [ReadyTarget a] , allBlocked :: [a] } | CycleInfo { depPairs :: [(a, a)] } -- | Given an ordering function representing the dependencies on a -- list of packages, return a ReadyTarget triple: One ready package, -- the packages that depend on the ready package directly or -- indirectly, and all the other packages. buildable :: forall a. (a -> DepInfo) -> [a] -> BuildableInfo a buildable relax packages = -- Find all packages which can't reach any other packages in the -- graph of the "has build dependency" relation. case partition (\ x -> reachable hasDep x == [x]) verts of -- None of the packages are buildable, return information -- about how to break this build dependency cycle. ([], _) -> CycleInfo {depPairs = map ofEdge $ head $ (allCycles hasDep)} -- We have some buildable packages, return them along with -- the list of packages each one directly blocks (allReady, blocked) -> BuildableInfo { readyTargets = map (makeReady blocked allReady) allReady , allBlocked = map ofVertex blocked } where makeReady :: [Vertex] -> [Vertex] -> Vertex -> ReadyTarget a makeReady blocked ready thisReady = let otherReady = filter (/= thisReady) ready (directlyBlocked, otherBlocked) = partition (\ x -> elem x (reachable isDep thisReady)) blocked in ReadyTarget { ready = ofVertex thisReady , waiting = map ofVertex directlyBlocked , other = map ofVertex (otherReady ++ otherBlocked) } --allDeps x = (ofVertex x, map ofVertex (filter (/= x) (reachable hasDep x))) isDep :: Graph isDep = transposeG hasDep hasDep :: Graph hasDep = buildG (0, length packages - 1) hasDepEdges hasDepEdges :: [(Int, Int)] hasDepEdges = nub (foldr f [] (tails vertPairs)) where f :: [(Int, DepInfo)] -> [(Int, Int)] -> [(Int, Int)] f [] es = es f (x : xs) es = catMaybes (map (toEdge x) xs) ++ es toEdge :: (Int, DepInfo) -> (Int, DepInfo) -> Maybe Edge toEdge (xv, xa) (yv, ya) = case compareSource xa ya of EQ -> Nothing LT -> Just (yv, xv) GT -> Just (xv, yv) ofEdge :: Edge -> (a, a) ofEdge (a, b) = (ofVertex a, ofVertex b) ofVertex :: Int -> a ofVertex n = fromJust (Map.findWithDefault Nothing n (Map.fromList (zip [0..] (map Just packages)))) verts :: [Int] verts = map fst vertPairs vertPairs :: [(Int, DepInfo)] vertPairs = zip [0..] $ map relax packages -- | Find a cycle in a graph that involves allCycles :: Graph -> [[Edge]] allCycles g = -- Every cycle is confined to an SCC (strongly connected component). -- Every node in an SCC is part of some cycle. concatMap sccCycles (scc g) where -- Find all the cycles in an SCC sccCycles :: Tree Vertex -> [[Edge]] sccCycles t = mapMaybe addBackEdge (treePaths t) addBackEdge :: [Vertex] -> Maybe [Edge] addBackEdge path@(root : _) = let back = (last path, root) in if elem back (edges g) then Just (pathEdges (path ++ [root])) else Nothing -- | All the paths from root to a leaf treePaths :: Tree a -> [[a]] treePaths (Node {rootLabel = r, subForest = []}) = [[r]] treePaths (Node {rootLabel = r, subForest = ts}) = map (r :) (concatMap treePaths ts) pathEdges :: [a] -> [(a, a)] pathEdges (v1 : v2 : vs) = (v1, v2) : pathEdges (v2 : vs) pathEdges _ = [] -- | Remove any packages which can't be built given that a package has failed. failPackage :: Eq a => (a -> a -> Ordering) -> a -> [a] -> ([a], [a]) failPackage cmp failed packages = let graph = buildGraph cmp packages in let root = elemIndex failed packages in let victims = maybe [] (map (fromJust . vertex) . reachable graph) root in partition (\ x -> not . elem x $ victims) packages where vertex n = Map.findWithDefault Nothing n vertexMap vertexMap = Map.fromList (zip [0..] (map Just packages)) -- | Given a list of packages, sort them according to their apparant -- build dependencies so that the first element doesn't depend on any -- of the other packages. orderSource :: (a -> a -> Ordering) -> [a] -> [a] orderSource cmp packages = map (fromJust . vertex) (topSort graph) where graph = buildGraph cmp packages vertex n = Map.findWithDefault Nothing n vertexMap vertexMap = Map.fromList (zip [0..] (map Just packages)) -- | Build a graph with the list of packages as its nodes and the -- build dependencies as its edges. buildGraph :: (a -> a -> Ordering) -> [a] -> Graph buildGraph cmp packages = let es = someEdges (zip packages [0..]) in buildG (0, length packages - 1) es where someEdges [] = [] someEdges (a : etc) = aEdges a etc ++ someEdges etc aEdges (ap, an) etc = concat (map (\ (bp, bn) -> case cmp ap bp of LT -> [(an, bn)] GT -> [(bn, an)] EQ -> []) etc) -- |This is a nice start. It ignores circular build depends and takes -- a pretty simplistic approach to 'or' build depends. However, I -- think this should work pretty nicely in practice. compareSource :: DepInfo -> DepInfo -> Ordering compareSource (DepInfo {relations = depends1, binaryNames = bins1}) (DepInfo {relations = depends2, binaryNames = bins2}) | any (\rel -> isJust (find (checkPackageNameReq rel) bins2)) (concat depends1) = GT | any (\rel -> isJust (find (checkPackageNameReq rel) bins1)) (concat depends2) = LT | otherwise = EQ where checkPackageNameReq :: Relation -> BinPkgName -> Bool checkPackageNameReq (Rel rPkgName _ _) bPkgName = rPkgName == bPkgName compareSource' :: HasDebianControl control => control -> control -> Ordering compareSource' control1 control2 | any (\rel -> isJust (find (checkPackageNameReq rel) bins2)) (concat depends1) = GT | any (\rel -> isJust (find (checkPackageNameReq rel) bins1)) (concat depends2) = LT | otherwise = EQ where bins1 = binaryNames' control1 bins2 = binaryNames' control2 depends1 = relations' control1 depends2 = relations' control2 checkPackageNameReq :: Relation -> BinPkgName -> Bool checkPackageNameReq (Rel rPkgName _ _) bPkgName = rPkgName == bPkgName -- |Return the dependency info for a list of control files. genDeps :: [FilePath] -> IO [DebianControl] genDeps controlFiles = do orderSource compareSource' <$> mapM genDep' controlFiles where -- Parse the control file and extract the build dependencies genDep' controlPath = parseControlFromFile controlPath >>= either (\ x -> throw (ParseRelationsError [$__LOC__] x)) (\ x -> validateDebianControl x {- `mapExn` (pushLoc $__LOC__) -} >>= either throw return) -- pushLoc :: Loc -> ControlFileError -> ControlFileError -- pushLoc loc e = e {locs = loc : locs e} -- |One example of how to tie the below functions together. In this -- case 'fp' is the path to a directory that contains a bunch of -- checked out source packages. The code will automatically look for -- debian\/control. It returns a list with the packages in the -- order they should be built. getSourceOrder :: FilePath -> IO [SrcPkgName] getSourceOrder fp = findControlFiles fp >>= genDeps >>= return . map sourceName' where -- Return a list of the files that look like debian\/control. findControlFiles :: FilePath -> IO [FilePath] findControlFiles root = getDirectoryContents root >>= mapM (\ x -> return $ root ++ "/" ++ x ++ "/debian/control") >>= filterM doesFileExist cabal-debian-4.31/debian-haskell/Debian/Util/0000755000000000000000000000000012565162075017064 5ustar0000000000000000cabal-debian-4.31/debian-haskell/Debian/Util/FakeChanges.hs0000644000000000000000000002430112565162075021557 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-} module Debian.Util.FakeChanges (fakeChanges) where --import Control.Arrow import Control.Exception import Control.Monad hiding (mapM) import qualified Data.ByteString.Lazy.Char8 as L import Data.Data (Data, Typeable) import qualified Data.Digest.Pure.MD5 as MD5 import Data.Foldable (concat, all, foldr) import Data.List as List (intercalate, nub, partition, isSuffixOf) import Data.Maybe import Debian.Pretty (prettyShow) import Data.Traversable import Debian.Control import qualified Debian.Deb as Deb import Debian.Time import Network.BSD (getHostName) import Prelude hiding (concat, foldr, all, mapM, sum) import System.Environment import System.FilePath import System.Posix.Files import Text.Regex.TDFA data Error = NoDebs | TooManyDscs [FilePath] | TooManyTars [FilePath] | TooManyDiffs [FilePath] | UnknownFiles [FilePath] | MalformedDebFilename [FilePath] | VersionMismatch [Maybe String] deriving (Read, Show, Eq, Typeable, Data) data Files = Files { dsc :: Maybe (FilePath, Paragraph) , debs :: [(FilePath, Paragraph)] , tar :: Maybe FilePath , diff :: Maybe FilePath } fakeChanges :: [FilePath] -> IO (FilePath, String) fakeChanges fps = do files <- loadFiles fps let version = getVersion files source = getSource files maintainer = getMaintainer files arches = getArches files binArch = getBinArch files dist = "unstable" urgency = "low" (invalid, binaries) = unzipEithers $ map (debNameSplit . fst) (debs files) when (not . null $ invalid) (error $ "Some .deb names are invalid: " ++ show invalid) uploader <- getUploader date <- getCurrentLocalRFC822Time fileLines <- mapM mkFileLine fps let changes = Control $ return . Paragraph $ map Field [ ("Format"," 1.7") , ("Date", ' ' : date) , ("Source", ' ' : source) , ("Binary", ' ' : (intercalate " " $ map (\(n,_,_) -> n) binaries)) , ("Architecture", ' ' : intercalate " " arches) , ("Version", ' ' : version) , ("Distribution", ' ' : dist) , ("Urgency", ' ' : urgency) , ("Maintainer", ' ' : maintainer) , ("Changed-By", ' ' : uploader) , ("Description", "\n Simulated description") , ("Changes", "\n" ++ unlines (map (' ':) [ source ++ " (" ++ version ++") " ++ dist ++ "; urgency=" ++ urgency , "." , " * Simulated changes" ] )) , ("Files", "\n" ++ unlines fileLines) ] return $ (concat [ source, "_", version, "_", binArch, ".changes"], prettyShow changes) -- let (invalid, binaries) = unzipEithers $ map debNameSplit debs {- when (not . null $ invalid) (throwDyn [MalformedDebFilename invalid]) version <- getVersion dsc debs putStrLn version source <- getSource dsc debs putStrLn source -} -- TODO: seems like this could be more aggressive about ensure the -- versions make sense. Except with packages like libc, the versions -- don't make sense. Maybe we want a flag that disables version check -- ? getVersion :: Files -> String getVersion files | isNothing (dsc files) = let versions = map (fieldValue "Version" . snd) (debs files) in if (all isJust versions) && (length (nub versions) == 1) then fromJust (head versions) else error (show [VersionMismatch (nub versions)]) | otherwise = case fieldValue "Version" (snd . fromJust $ dsc files) of (Just v) -> v Nothing -> error $ "show (dsc files)" ++ " does not have a Version field :(" getSource :: Files -> String getSource files = let dscSource = case (dsc files) of Nothing -> [] (Just (fp, p)) -> case fieldValue "Source" p of (Just v) -> [v] Nothing -> error $ fp ++ " does not have a Source field :(" debSources = map debSource (debs files) srcs = nub (dscSource ++ debSources) in if (singleton srcs) then (head srcs) else error $ "Could not determine source." where debSource (deb,p) = case (fieldValue "Source" p) of (Just v) -> v Nothing -> case fieldValue "Package" p of (Just v) -> v Nothing -> error $ "Could not find Source or Package field in " ++ deb getMaintainer :: Files -> String getMaintainer files | isJust (dsc files) = let (fp, p) = fromJust (dsc files) in case fieldValue "Maintainer" p of Nothing -> error $ fp ++ " is missing the Maintainer field." (Just v) -> v | otherwise = let maintainers = catMaybes $ map (fieldValue "Maintainer" . snd) (debs files) maintainer = nub maintainers in if singleton maintainer then head maintainer else error $ "Could not uniquely determine the maintainer: " ++ show maintainer getArches :: Files -> [String] getArches files = let debArchs = map (fieldValue "Architecture" . snd) (debs files) tarArch = fmap (const "source") (tar files) diffArch = fmap (const "source") (diff files) in nub $ catMaybes (tarArch : diffArch : debArchs) getBinArch :: Files -> String getBinArch files = let binArch = nub $ mapMaybe (fieldValue "Architecture" . snd) (debs files) in if singleton binArch then head binArch else case (filter (/= "all") binArch) of [b] -> b _ -> error $ "Could not uniquely determine binary architecture: " ++ show binArch mkFileLine :: FilePath -> IO String mkFileLine fp | ".deb" `isSuffixOf` fp = do sum <- L.readFile fp >>= return . show . MD5.md5 size <- liftM fileSize $ getFileStatus fp (Control (p:_)) <- Deb.fields fp return $ concat [ " ", sum, " ", show size, " ", fromMaybe "unknown" (fieldValue "Section" p), " " , fromMaybe "optional" (fieldValue "Priority" p), " ", (takeBaseName fp) ] | otherwise = do sum <- L.readFile fp >>= return . show . MD5.md5 size <- liftM fileSize $ getFileStatus fp return $ concat [ " ", sum, " ", show size, " ", "unknown", " " , "optional"," ", (takeBaseName fp) ] -- more implementations can be found at: -- http://www.google.com/codesearch?hl=en&lr=&q=%22%5BEither+a+b%5D+-%3E+%28%5Ba%5D%2C%5Bb%5D%29%22&btnG=Search unzipEithers :: [Either a b] -> ([a],[b]) unzipEithers = foldr unzipEither ([],[]) where unzipEither (Left l) ~(ls, rs) = (l:ls, rs) unzipEither (Right r) ~(ls, rs) = (ls, r:rs) -- move to different library debNameSplit :: String -> Either FilePath (String, String, String) debNameSplit fp = case (takeFileName fp) =~ "^(.*)_(.*)_(.*).deb$" of [[_, name, version, arch]] -> Right (name, version, arch) _ -> Left fp loadFiles :: [FilePath] -> IO Files loadFiles files = let (dscs', files'') = partition (isSuffixOf ".dsc") files' (debs', files') = partition (isSuffixOf ".deb") files (tars', files''') = partition (isSuffixOf ".tar.gz") files'' (diffs', rest) = partition (isSuffixOf ".diff.gz") files''' errors = concat [ if (length debs' < 1) then [NoDebs] else [] , if (length dscs' > 1) then [TooManyDscs dscs'] else [] , if (length tars' > 1) then [TooManyTars tars'] else [] , if (length diffs' > 1) then [TooManyDiffs diffs'] else [] , if (length rest > 0) then [UnknownFiles rest] else [] ] in do when (not . null $ errors) (error $ show errors) dsc' <- mapM loadDsc (listToMaybe dscs') debs'' <- mapM loadDeb debs' return $ Files { dsc = dsc', debs = debs'', tar = listToMaybe tars', diff = listToMaybe diffs' } -- if (not . null $ errors) then throwDyn errors else return (debs, listToMaybe dscs, listToMaybe tars, listToMaybe diffs) where loadDsc :: FilePath -> IO (FilePath, Paragraph) loadDsc dsc' = do res <- parseControlFromFile dsc' case res of (Left e) -> error $ "Error parsing " ++ dsc' ++ "\n" ++ show e (Right (Control [p])) -> return (dsc', p) (Right c) -> error $ dsc' ++ " did not have exactly one paragraph: " ++ prettyShow c loadDeb :: FilePath -> IO (FilePath, Paragraph) loadDeb deb = do res <- Deb.fields deb case res of (Control [p]) -> return (deb, p) _ -> error $ deb ++ " did not have exactly one paragraph: " ++ prettyShow res getUploader :: IO String getUploader = do debFullName <- do dfn <- try (getEnv "DEBFULLNAME") case dfn of (Right n) -> return n (Left (_ :: SomeException)) -> do dfn' <-try (getEnv "USER") case dfn' of (Right n) -> return n (Left (_ :: SomeException)) -> error $ "Could not determine user name, neither DEBFULLNAME nor USER enviroment variables were set." emailAddr <- do eml <- try (getEnv "DEBEMAIL") case eml of (Right e) -> return e (Left (_ :: SomeException)) -> do eml' <- try (getEnv "EMAIL") case eml' of (Right e) -> return e (Left (_ :: SomeException)) -> getHostName -- FIXME: this is not a FQDN return $ debFullName ++ " <" ++ emailAddr ++ ">" -- * Utils singleton :: [a] -> Bool singleton [_] = True singleton _ = False cabal-debian-4.31/debian-haskell/Debian/Version/0000755000000000000000000000000012565162075017574 5ustar0000000000000000cabal-debian-4.31/debian-haskell/Debian/Version/Internal.hs0000644000000000000000000000201712565162075021704 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} module Debian.Version.Internal ( DebianVersion(..) , Numeric(..) , NonNumeric(..) , Found(..) ) where import Data.Data (Data) import Data.Typeable (Typeable) -- Currently we store the original version string in the data-type so -- that we can faithfully reproduce it quickly. Currently we do not -- have any way to modify a version number -- so this works fine. May -- have to change later. data DebianVersion = DebianVersion String (Found Int, NonNumeric, Found NonNumeric) deriving (Data, Typeable) data NonNumeric = NonNumeric String (Found Numeric) deriving (Show, Data, Typeable) data Numeric = Numeric Int (Maybe NonNumeric) deriving (Show, Data, Typeable) data Found a = Found { unFound :: a } | Simulated { unFound :: a } deriving (Show, Data, Typeable) instance (Eq a) => Eq (Found a) where f1 == f2 = (unFound f1) == (unFound f2) instance (Ord a) => Ord (Found a) where compare f1 f2 = compare (unFound f1) (unFound f2) cabal-debian-4.31/debian-haskell/Debian/Version/Common.hs0000644000000000000000000001472112565162075021365 0ustar0000000000000000-- |A module for parsing, comparing, and (eventually) modifying debian version -- numbers. {-# LANGUAGE FlexibleInstances #-} {-# OPTIONS -fno-warn-orphans -fno-warn-unused-do-bind #-} module Debian.Version.Common ( DebianVersion -- |Exported abstract because the internal representation is likely to change , prettyDebianVersion , ParseDebianVersion(..) , evr -- DebianVersion -> (Maybe Int, String, Maybe String) , epoch , version , revision , buildDebianVersion , parseDV ) where import Data.Char (ord, isDigit, isAlpha) import Debian.Pretty (PP(..)) import Debian.Version.Internal import Text.ParserCombinators.Parsec import Text.Regex import Text.PrettyPrint (Doc, render) import Text.PrettyPrint.HughesPJClass (Pretty(pPrint), text) prettyDebianVersion :: DebianVersion -> Doc prettyDebianVersion (DebianVersion s _) = text s instance Pretty (PP DebianVersion) where pPrint = prettyDebianVersion . unPP instance Eq DebianVersion where (DebianVersion _ v1) == (DebianVersion _ v2) = v1 == v2 instance Ord DebianVersion where compare (DebianVersion _ v1) (DebianVersion _ v2) = compare v1 v2 instance Show DebianVersion where show v = "(Debian.Version.parseDebianVersion (" ++ show (render (prettyDebianVersion v)) ++ " :: String))" -- make ~ less than everything, and everything else higher that letters order :: Char -> Int order c | isDigit c = 0 | isAlpha c = ord c | c == '~' = -1 | otherwise = (ord c) + 256 -- |We have to do this wackiness because ~ is less than the empty string compareNonNumeric :: [Char] -> [Char] -> Ordering compareNonNumeric "" "" = EQ compareNonNumeric "" ('~':_cs) = GT compareNonNumeric ('~':_cs) "" = LT compareNonNumeric "" _ = LT compareNonNumeric _ "" = GT compareNonNumeric (c1:cs1) (c2:cs2) = if (order c1) == (order c2) then compareNonNumeric cs1 cs2 else compare (order c1) (order c2) instance Eq NonNumeric where (NonNumeric s1 n1) == (NonNumeric s2 n2) = case compareNonNumeric s1 s2 of EQ -> n1 == n2 _o -> False instance Ord NonNumeric where compare (NonNumeric s1 n1) (NonNumeric s2 n2) = case compareNonNumeric s1 s2 of EQ -> compare n1 n2 o -> o instance Eq Numeric where (Numeric n1 mnn1) == (Numeric n2 mnn2) = case compare n1 n2 of EQ -> case compareMaybeNonNumeric mnn1 mnn2 of EQ -> True _ -> False _ -> False compareMaybeNonNumeric :: Maybe NonNumeric -> Maybe NonNumeric -> Ordering compareMaybeNonNumeric mnn1 mnn2 = case (mnn1, mnn2) of (Nothing, Nothing) -> EQ (Just (NonNumeric nn _), Nothing) -> compareNonNumeric nn "" (Nothing, Just (NonNumeric nn _)) -> compareNonNumeric "" nn (Just nn1, Just nn2) -> compare nn1 nn2 instance Ord Numeric where compare (Numeric n1 mnn1) (Numeric n2 mnn2) = case compare n1 n2 of EQ -> compareMaybeNonNumeric mnn1 mnn2 o -> o -- * Parser class ParseDebianVersion a where parseDebianVersion :: a-> DebianVersion -- |Convert a string to a debian version number. May throw an -- exception if the string is unparsable -- but I am not sure if that -- can currently happen. Are there any invalid version strings? -- Perhaps ones with underscore, or something? {- showNN :: NonNumeric -> String showNN (NonNumeric s n) = s ++ showN n showN :: Found Numeric -> String showN (Found (Numeric n nn)) = show n ++ maybe "" showNN nn showN (Simulated _) = "" -} parseDV :: CharParser () (Found Int, NonNumeric, Found NonNumeric) parseDV = do skipMany $ oneOf " \t" e <- parseEpoch upstreamVersion <- parseNonNumeric True True debianRevision <- option (Simulated (NonNumeric "" (Simulated (Numeric 0 Nothing)))) (char '-' >> parseNonNumeric True False >>= return . Found) return (e, upstreamVersion, debianRevision) parseEpoch :: CharParser () (Found Int) parseEpoch = option (Simulated 0) (try (many1 digit >>= \d -> char ':' >> return (Found (read d)))) parseNonNumeric :: Bool -> Bool -> CharParser () NonNumeric parseNonNumeric zeroOk upstream = do nn <- (if zeroOk then many else many1) ((noneOf "-0123456789") <|> (if upstream then upstreamDash else pzero)) n <- parseNumeric upstream return $ NonNumeric nn n where upstreamDash :: CharParser () Char upstreamDash = try $ do char '-' lookAhead $ (many (noneOf "- \n\t") >> char '-') return '-' parseNumeric :: Bool -> CharParser () (Found Numeric) parseNumeric upstream = do n <- many1 (satisfy isDigit) nn <- option Nothing (parseNonNumeric False upstream >>= return . Just) return $ Found (Numeric (read n) nn) <|> return (Simulated (Numeric 0 Nothing)) {- compareTest :: String -> String -> Ordering compareTest str1 str2 = let v1 = either (error . show) id $ parse parseDV str1 str1 v2 = either (error . show) id $ parse parseDV str2 str2 in compare v1 v2 -} -- |Split a DebianVersion into its three components: epoch, version, -- revision. It is not safe to use the parsed version number for -- this because you will lose information, such as leading zeros. evr :: DebianVersion -> (Maybe Int, String, Maybe String) evr (DebianVersion s _) = let re = mkRegex "^(([0-9]+):)?(([^-]*)|((.*)-([^-]*)))$" in -- ( ) ( ( )) -- ( e ) ( v ) (v2) ( r ) case matchRegex re s of Just ["", _, _, v, "", _, _] -> (Nothing, v, Nothing) Just ["", _, _, _, _, v, r] -> (Nothing, v, Just r) Just [_, e, _, v, "", _, _] -> (Just (read e), v, Nothing) Just [_, e, _, _, _, v, r] -> (Just (read e), v, Just r) -- I really don't think this can happen. _ -> error ("Invalid Debian Version String: " ++ s) epoch :: DebianVersion -> Maybe Int epoch v = case evr v of (x, _, _) -> x version :: DebianVersion -> String version v = case evr v of (_, x, _) -> x revision :: DebianVersion -> Maybe String revision v = case evr v of (_, _, x) -> x -- Build a Debian version number from epoch, version, revision buildDebianVersion :: Maybe Int -> String -> Maybe String -> DebianVersion buildDebianVersion e v r = either (error . show) (DebianVersion str) $ parse parseDV str str where str = (maybe "" (\ n -> show n ++ ":") e ++ v ++ maybe "" (\ s -> "-" ++ s) r) cabal-debian-4.31/debian-haskell/Debian/Version/Text.hs0000644000000000000000000000071112565162075021053 0ustar0000000000000000{-# OPTIONS -fno-warn-orphans #-} module Debian.Version.Text ( ParseDebianVersion(..) ) where import Text.ParserCombinators.Parsec import qualified Data.Text as T import Debian.Version.Common import Debian.Version.Internal instance ParseDebianVersion T.Text where parseDebianVersion text = let str = T.unpack text in case parse parseDV str str of Left e -> error (show e) Right dv -> DebianVersion str dv cabal-debian-4.31/debian-haskell/Debian/Version/ByteString.hs0000644000000000000000000000074712565162075022232 0ustar0000000000000000{-# OPTIONS -fno-warn-orphans #-} module Debian.Version.ByteString ( ParseDebianVersion(..) ) where import Text.ParserCombinators.Parsec import qualified Data.ByteString.Char8 as C import Debian.Version.Common import Debian.Version.Internal instance ParseDebianVersion C.ByteString where parseDebianVersion byteStr = let str = C.unpack byteStr in case parse parseDV str str of Left e -> error (show e) Right dv -> DebianVersion str dv cabal-debian-4.31/debian-haskell/Debian/Version/String.hs0000644000000000000000000000142012565162075021373 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} {-# OPTIONS -fno-warn-orphans #-} module Debian.Version.String ( ParseDebianVersion(..) ) where import Text.ParserCombinators.Parsec import Data.List (stripPrefix) import Debian.Version.Common import Debian.Version.Internal instance ParseDebianVersion String where parseDebianVersion str = case parse parseDV str str of Left e -> error (show e) Right dv -> DebianVersion str dv instance Read DebianVersion where readsPrec _ s = case stripPrefix "Debian.Version.parseDebianVersion " s of Just s' -> case reads s' :: [(String, String)] of []-> [] (v, s'') : _ -> [(parseDebianVersion v, s'')] Nothing -> [] cabal-debian-4.31/debian-haskell/Debian/Relation/0000755000000000000000000000000012565162075017724 5ustar0000000000000000cabal-debian-4.31/debian-haskell/Debian/Relation/Common.hs0000644000000000000000000001124412565162075021512 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, FlexibleInstances, OverloadedStrings, TypeSynonymInstances #-} module Debian.Relation.Common where -- Standard GHC Modules import Data.Data (Data) import Data.List as List (map, intersperse) import Data.Monoid (mconcat, (<>)) import Data.Function import Data.Set as Set (Set, toList) import Data.Typeable (Typeable) import Debian.Arch (Arch, prettyArch) import Debian.Pretty (PP(..)) import Prelude hiding (map) import Text.ParserCombinators.Parsec import Text.PrettyPrint (Doc, text, empty) import Text.PrettyPrint.HughesPJClass (Pretty(pPrint)) -- Local Modules import Debian.Version -- Datatype for relations type Relations = AndRelation type AndRelation = [OrRelation] type OrRelation = [Relation] data Relation = Rel BinPkgName (Maybe VersionReq) (Maybe ArchitectureReq) deriving (Eq, Read, Show) newtype SrcPkgName = SrcPkgName {unSrcPkgName :: String} deriving (Read, Show, Eq, Ord, Data, Typeable) newtype BinPkgName = BinPkgName {unBinPkgName :: String} deriving (Read, Show, Eq, Ord, Data, Typeable) class Pretty (PP a) => PkgName a where pkgNameFromString :: String -> a instance PkgName BinPkgName where pkgNameFromString = BinPkgName instance PkgName SrcPkgName where pkgNameFromString = SrcPkgName class ParseRelations a where -- |'parseRelations' parse a debian relation (i.e. the value of a -- Depends field). Return a parsec error or a value of type -- 'Relations' parseRelations :: a -> Either ParseError Relations -- | This needs to be indented for use in a control file: intercalate "\n " . lines . show prettyRelations :: [[Relation]] -> Doc prettyRelations xss = mconcat . intersperse (text "\n, ") . List.map prettyOrRelation $ xss prettyOrRelation :: [Relation] -> Doc prettyOrRelation xs = mconcat . intersperse (text " | ") . List.map prettyRelation $ xs prettyRelation :: Relation -> Doc prettyRelation (Rel name ver arch) = pPrint (PP name) <> maybe empty prettyVersionReq ver <> maybe empty prettyArchitectureReq arch instance Ord Relation where compare (Rel pkgName1 mVerReq1 _mArch1) (Rel pkgName2 mVerReq2 _mArch2) = case compare pkgName1 pkgName2 of LT -> LT GT -> GT EQ -> compare mVerReq1 mVerReq2 data ArchitectureReq = ArchOnly (Set Arch) | ArchExcept (Set Arch) deriving (Eq, Ord, Read, Show) prettyArchitectureReq :: ArchitectureReq -> Doc prettyArchitectureReq (ArchOnly arch) = text " [" <> mconcat (List.map prettyArch (toList arch)) <> text "]" prettyArchitectureReq (ArchExcept arch) = text " [" <> mconcat (List.map ((text "!") <>) (List.map prettyArch (toList arch))) <> text "]" data VersionReq = SLT DebianVersion | LTE DebianVersion | EEQ DebianVersion | GRE DebianVersion | SGR DebianVersion deriving (Eq, Read, Show) prettyVersionReq :: VersionReq -> Doc prettyVersionReq (SLT v) = text " (<< " <> prettyDebianVersion v <> text ")" prettyVersionReq (LTE v) = text " (<= " <> prettyDebianVersion v <> text ")" prettyVersionReq (EEQ v) = text " (= " <> prettyDebianVersion v <> text ")" prettyVersionReq (GRE v) = text " (>= " <> prettyDebianVersion v <> text ")" prettyVersionReq (SGR v) = text " (>> " <> prettyDebianVersion v <> text ")" -- |The sort order is based on version number first, then on the kind of -- relation, sorting in the order <<, <= , ==, >= , >> instance Ord VersionReq where compare = compare `on` extr where extr (SLT v) = (v,0 :: Int) extr (LTE v) = (v,1 :: Int) extr (EEQ v) = (v,2 :: Int) extr (GRE v) = (v,3 :: Int) extr (SGR v) = (v,4 :: Int) -- |Check if a version number satisfies a version requirement. checkVersionReq :: Maybe VersionReq -> Maybe DebianVersion -> Bool checkVersionReq Nothing _ = True checkVersionReq _ Nothing = False checkVersionReq (Just (SLT v1)) (Just v2) = v2 < v1 checkVersionReq (Just (LTE v1)) (Just v2) = v2 <= v1 checkVersionReq (Just (EEQ v1)) (Just v2) = v2 == v1 checkVersionReq (Just (GRE v1)) (Just v2) = v2 >= v1 checkVersionReq (Just (SGR v1)) (Just v2) = v2 > v1 instance Pretty (PP BinPkgName) where pPrint = text . unBinPkgName . unPP instance Pretty (PP SrcPkgName) where pPrint = text . unSrcPkgName . unPP -- | Wrap `PP` around type synonyms that might overlap with the -- `Pretty [a]` instance. instance Pretty (PP Relations) where pPrint = prettyRelations . unPP instance Pretty (PP OrRelation) where pPrint = prettyOrRelation . unPP instance Pretty (PP Relation) where pPrint = prettyRelation . unPP instance Pretty (PP VersionReq) where pPrint = prettyVersionReq . unPP instance Pretty (PP ArchitectureReq) where pPrint = prettyArchitectureReq . unPP cabal-debian-4.31/debian-haskell/Debian/Relation/Text.hs0000644000000000000000000000133612565162075021207 0ustar0000000000000000{-# OPTIONS -fno-warn-orphans #-} -- |A module for working with debian relationships module Debian.Relation.Text ( -- * Types AndRelation , OrRelation , Relations , Relation(..) , ArchitectureReq(..) , VersionReq(..) -- * Helper Functions , checkVersionReq -- * Relation Parser , RelParser , ParseRelations(..) ) where import qualified Data.Text as T -- Local Modules --import Debian.Relation.Common import Debian.Relation.String --import Debian.Version -- * ParseRelations -- For now we just wrap the string version instance ParseRelations T.Text where parseRelations text = parseRelations (T.unpack text) cabal-debian-4.31/debian-haskell/Debian/Relation/ByteString.hs0000644000000000000000000000137412565162075022357 0ustar0000000000000000{-# OPTIONS -fno-warn-orphans #-} -- |A module for working with debian relationships module Debian.Relation.ByteString ( -- * Types AndRelation , OrRelation , Relations , Relation(..) , ArchitectureReq(..) , VersionReq(..) -- * Helper Functions , checkVersionReq -- * Relation Parser , RelParser , ParseRelations(..) ) where import qualified Data.ByteString.Char8 as C -- Local Modules --import Debian.Relation.Common import Debian.Relation.String --import Debian.Version -- * ParseRelations -- For now we just wrap the string version instance ParseRelations C.ByteString where parseRelations byteStr = parseRelations (C.unpack byteStr) cabal-debian-4.31/debian-haskell/Debian/Relation/String.hs0000644000000000000000000000775512565162075021544 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, PackageImports, TypeSynonymInstances #-} {-# OPTIONS -fno-warn-unused-do-bind -fno-warn-orphans #-} -- |A module for working with debian relationships module Debian.Relation.String ( -- * Types AndRelation , OrRelation , Relations , Relation(..) , ArchitectureReq(..) , VersionReq(..) -- * Helper Functions , checkVersionReq -- * Relation Parser , RelParser , ParseRelations(..) , pRelations ) where -- Standard GHC Modules import "mtl" Control.Monad.Identity (Identity) import Data.Set (fromList) import Text.ParserCombinators.Parsec import Text.Parsec.Prim (ParsecT) -- Local Modules import Debian.Arch (Arch, parseArch) import Debian.Relation.Common import Debian.Version -- * ParseRelations instance ParseRelations String where parseRelations str = let str' = scrub str in case parse pRelations str' str' of Right relations -> Right (filter (/= []) relations) x -> x where scrub = unlines . filter (not . comment) . lines comment s = case dropWhile (`elem` " \t") s of ('#' : _) -> True _ -> False -- * Relation Parser type RelParser a = CharParser () a -- "Correct" dependency lists are separated by commas, but sometimes they -- are omitted and it is possible to parse relations without them. pRelations :: RelParser Relations pRelations = do -- rel <- sepBy pOrRelation (char ',') rel <- many pOrRelation eof return rel pOrRelation :: RelParser OrRelation pOrRelation = do skipMany (char ',' <|> whiteChar) rel <- sepBy1 pRelation (char '|') skipMany (char ',' <|> whiteChar) return rel whiteChar :: ParsecT String u Identity Char whiteChar = oneOf [' ','\t','\n'] pRelation :: RelParser Relation pRelation = do skipMany whiteChar pkgName <- many1 (noneOf [' ',',','|','\t','\n','(']) skipMany whiteChar mVerReq <- pMaybeVerReq skipMany whiteChar mArch <- pMaybeArch return $ Rel (BinPkgName pkgName) mVerReq mArch pMaybeVerReq :: RelParser (Maybe VersionReq) pMaybeVerReq = do char '(' skipMany whiteChar op <- pVerReq skipMany whiteChar ver <- many1 (noneOf [' ',')','\t','\n']) skipMany whiteChar char ')' return $ Just (op (parseDebianVersion ver)) <|> do return $ Nothing pVerReq :: ParsecT [Char] u Identity (DebianVersion -> VersionReq) pVerReq = do char '<' (do char '<' <|> char ' ' <|> char '\t' return $ SLT <|> do char '=' return $ LTE) <|> do string "=" return $ EEQ <|> do char '>' (do char '=' return $ GRE <|> do char '>' <|> char ' ' <|> char '\t' return $ SGR) pMaybeArch :: RelParser (Maybe ArchitectureReq) pMaybeArch = do char '[' (do archs <- pArchExcept char ']' skipMany whiteChar return (Just (ArchExcept (fromList . map parseArchExcept $ archs))) <|> do archs <- pArchOnly char ']' skipMany whiteChar return (Just (ArchOnly (fromList . map parseArch $ archs))) ) <|> return Nothing -- Some packages (e.g. coreutils) have architecture specs like [!i386 -- !hppa], even though this doesn't really make sense: once you have -- one !, anything else you include must also be (implicitly) a !. pArchExcept :: RelParser [String] pArchExcept = sepBy (char '!' >> many1 (noneOf [']',' '])) (skipMany1 whiteChar) pArchOnly :: RelParser [String] pArchOnly = sepBy (many1 (noneOf [']',' '])) (skipMany1 whiteChar) -- | Ignore the ! if it is present, we already know this list has at -- least one, and the rest are implicit. parseArchExcept :: String -> Arch parseArchExcept ('!' : s) = parseArch s parseArchExcept s = parseArch s cabal-debian-4.31/debian-haskell/Debian/Apt/0000755000000000000000000000000012565162075016673 5ustar0000000000000000cabal-debian-4.31/debian-haskell/Debian/Apt/Methods.hs0000644000000000000000000004674412565162075020651 0ustar0000000000000000{-# LANGUAGE PackageImports #-} {-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-name-shadowing #-} -- |an interface for using the methods in /var/lib/apt/methods module Debian.Apt.Methods ( withMethodPath , withMethodURI , whichMethodPath , openMethod , closeMethod , recvStatus , sendCommand , getLastModified , simpleFetch , fetch , FetchCallbacks(..) , emptyFetchCallbacks , cliFetchCallbacks , Command(..) , Status(..) , Message, Site, User, Password, Media, Drive, Header, ConfigItem ) where import Debian.Time import Debian.URI import Control.Exception import "mtl" Control.Monad.Error import Data.Maybe import Data.Time import System.Directory import System.Exit import System.IO import System.Posix.Files import System.Process type MethodHandle = (Handle, Handle, Handle, ProcessHandle) capabilities, logMsg, status, uriStart, uriDone, uriFailure, generalFailure, authorizationRequired, mediaFailure, uriAcquire, configuration, authorizationCredentials, mediaChanged :: String capabilities = "100" logMsg = "101" status = "102" uriStart = "200" uriDone = "201" uriFailure = "400" generalFailure = "401" authorizationRequired = "402" mediaFailure = "403" uriAcquire = "600" configuration = "601" authorizationCredentials = "602" mediaChanged = "603" type Message = String type Site = String type User = String type Password = String type Media = String type Drive = String data Status = Capabilities { version :: String, singleInstance :: Bool, preScan :: Bool, pipeline :: Bool, sendConfig :: Bool , needsCleanup :: Bool, localOnly :: Bool } | LogMsg Message | Status URI Message | URIStart { uri :: URI, size :: Maybe Integer, lastModified :: Maybe UTCTime, resumePoint :: Maybe Integer } | URIDone { uri :: URI, size :: Maybe Integer, lastModified :: Maybe UTCTime, resumePoint :: Maybe Integer , filename :: Maybe FilePath, hashes :: Hashes, imsHit :: Bool } | URIFailure { uri :: URI, message :: Message } | GeneralFailure Message | AuthorizationRequired Site | MediaFailure Media Drive deriving (Show, Eq) data Hashes = Hashes { md5 :: Maybe String , sha1 :: Maybe String , sha256 :: Maybe String } deriving (Show, Eq) emptyHashes = Hashes Nothing Nothing Nothing data Command = URIAcquire URI FilePath (Maybe UTCTime) | Configuration [ConfigItem] | AuthorizationCredentials Site User Password | MediaChanged Media (Maybe Bool) -- I don't really understand the Fail field, I am assuming it is 'Fail: true' deriving (Show, Eq) type Header = (String, String) type ConfigItem = (String, String) withMethodURI :: URI -> (MethodHandle -> IO a) -> IO a withMethodURI uri f = do mp <- liftM fromJust (whichMethodPath uri) withMethodPath mp f -- |withMethod - run |methodPath| bracketed with -- openMethod\/closeMethod. |f| gets the open handle. withMethodPath :: FilePath -> (MethodHandle -> IO a) -> IO a withMethodPath methodPath f = bracket (openMethod methodPath) closeMethod $ f -- |whichMethodBinary - find the method executable associated with a URI -- throws an exception on failure whichMethodPath :: URI -> IO (Maybe FilePath) whichMethodPath uri = let scheme = init (uriScheme uri) path = "/usr/lib/apt/methods/" ++ scheme in doesFileExist path >>= return . bool Nothing (Just path) {- The flow of messages starts with the method sending out a 100 Capabilities and APT sending out a 601 Configuration. The flow is largely unsynchronized, but our function may have to respond to things like authorization requests. Perhaps we do a recvContents and then mapM_ over that ? Not all incoming messages require a response, so... -} parseStatus :: [String] -> Status parseStatus [] = error "parseStatus" parseStatus (code' : headers') = parseStatus' (take 3 code') (map parseHeader headers') where parseStatus' code headers | code == capabilities = foldr updateCapability defaultCapabilities headers where updateCapability (a,v) c | a == "Version" = c { version = v } | a == "Single-Instance" = c { singleInstance = parseTrueFalse v } | a == "Pre-Scan" = c { preScan = parseTrueFalse v } | a == "Pipeline" = c { pipeline = parseTrueFalse v } | a == "Send-Config" = c { sendConfig = parseTrueFalse v } | a == "Needs-Cleanup" = c { needsCleanup = parseTrueFalse v } | a == "Local-Only" = c { localOnly = parseTrueFalse v } | otherwise = error $ "unknown capability: " ++ show (a,v) defaultCapabilities = Capabilities { version = "" , singleInstance = False , preScan = False , pipeline = False , sendConfig = False , needsCleanup = False , localOnly = False } parseStatus' code headers | code == logMsg = case headers of [("Message", msg)] -> LogMsg msg _ -> error "parseStatus'" | code == status = Status (fromJust $ parseURI $ fromJust $ lookup "URI" headers) (fromJust $ lookup "Message" headers) | code == uriStart = foldr updateUriStart (URIStart undefined Nothing Nothing Nothing) headers where updateUriStart (a,v) u | a == "URI" = u { uri = fromJust $ parseURI v } | a == "Size" = u { size = Just (read v) } | a == "Last-Modified" = u { lastModified = parseTimeRFC822 v } -- if the date is unparseable, we silently truncate. Is that bad ? | a == "Resume-Point" = u { resumePoint = Just (read v) } updateUriStart _ _ = error "updateUriStart" parseStatus' code headers | code == uriDone = foldr updateUriDone (URIDone undefined Nothing Nothing Nothing Nothing emptyHashes False) headers where updateUriDone (a,v) u | a == "URI" = u { uri = fromJust $ parseURI v } | a == "Size" = u { size = Just (read v) } | a == "Last-Modified" = u { lastModified = parseTimeRFC822 v } -- if the date is unparseable, we silently truncate. Is that bad ? | a == "Filename" = u { filename = Just v } | a == "MD5Sum-Hash" = u { hashes = (hashes u) { md5 = Just v } } | a == "MD5-Hash" = u { hashes = (hashes u) { md5 = Just v } } | a == "SHA1-Hash" = u { hashes = (hashes u) { sha1 = Just v } } | a == "SHA256-Hash" = u { hashes = (hashes u) { sha256 = Just v } } | a == "Resume-Point" = u { resumePoint = Just (read v) } | a == "IMS-Hit" && v == "true" = u { imsHit = True } | otherwise = error $ "updateUriDone: unknown header: " ++ show (a,v) parseStatus' code headers | code == uriFailure = URIFailure (fromJust $ parseURI $ fromJust $ lookup "URI" headers) (fromJust $ lookup "Message" headers) | code == generalFailure = GeneralFailure (fromJust $ lookup "Message" headers) | code == authorizationRequired = AuthorizationRequired (fromJust $ lookup "Site" headers) | code == mediaFailure = MediaFailure (fromJust $ lookup "Media" headers) (fromJust $ lookup "Drive" headers) parseStatus' _ _ = error "parseStatus'" formatCommand :: Command -> [String] formatCommand (URIAcquire uri filepath mLastModified) = [ uriAcquire ++ " URI Acquire" , "URI: " ++ uriToString' uri -- will this get credentials correct ? Or do we always pass those in seperately , "FileName: " ++ filepath ] ++ maybe [] (\lm -> ["Last-Modified: " ++ formatTimeRFC822 lm ]) mLastModified formatCommand (Configuration configItems) = (configuration ++ " Configuration") : (map formatConfigItem configItems) where formatConfigItem (a,v) = concat ["Config-Item: ", a, "=", v] formatCommand (AuthorizationCredentials site user passwd) = (authorizationCredentials ++ " Authorization Credentials") : [ "Site: " ++ site , "User: " ++ user , "Password: " ++ passwd ] formatCommand (MediaChanged media mFail) = [ mediaChanged ++ " Media Changed" , "Media: " ++ media ] ++ maybe [] (\b -> ["Fail: " ++ case b of True -> "true" ; False -> "false"]) mFail parseTrueFalse :: String -> Bool parseTrueFalse "true" = True parseTrueFalse "false" = False parseTrueFalse s = error $ "Invalid boolean string: " ++ s recvStatus :: MethodHandle -> IO Status recvStatus mh = liftM parseStatus $ recv mh sendCommand :: MethodHandle -> Command -> IO () sendCommand mh cmd = sendMethod mh (formatCommand cmd) parseHeader :: String -> Header parseHeader str = let (a, r) = span (/= ':') str v = dropWhile (flip elem ": \t") r in (a, v) openMethod :: FilePath -> IO MethodHandle openMethod methodBinary = do -- hPutStrLn stderr ("openMethod " ++ methodBinary) runInteractiveCommand methodBinary -- runInteractiveProcess methodBinary [] Nothing Nothing sendMethod :: MethodHandle -> [String] -> IO () sendMethod (pIn, _pOut, _, _) strings = do -- hPutStrLn stderr "send:" mapM_ put strings hPutStrLn pIn "" hFlush pIn where put line = do -- hPutStrLn stderr (" " ++ line) hPutStrLn pIn line closeMethod :: MethodHandle -> IO ExitCode closeMethod (pIn, pOut, pErr, handle) = do -- hPutStrLn stderr "closeMethod" hClose pIn hClose pOut hClose pErr waitForProcess handle recv :: MethodHandle -> IO [String] recv (_pIn, pOut, _pErr, _pHandle) = do -- hPutStrLn stderr "recv:" readTillEmptyLine pOut where readTillEmptyLine pOut = do line <- hGetLine pOut case line of "" -> return [] line -> do -- hPutStrLn stderr (" " ++ line) tail <- readTillEmptyLine pOut return $ line : tail {- The flow of messages starts with the method sending out a 100 Capabilities and APT sending out a 601 Configuration. The flow is largely unsynchronized, but our function may have to respond to things like authorization requests. Perhaps we do a recvContents and then mapM_ over that ? Not all incoming messages require a response. We probably also need to track state, for example, if we are pipelining multiple downloads and want to show seperate progress bars for each download. If someone wants to use fetch, they will need to provide methods to: 1. prompt for and provide authentication 2. show progress 3. show media change dialog 4. Show log messages 5. Show failures 6. Send Configuration pipeline vs non-pipeline mode. what if different methods are being used ? when pipelining, we probably don't want to have too many pipelines to the same server. Perhaps there can be a limit, and for non-pipelinable methods, we set the limit to 1. Each method can run in a seperate thread, since methods do not interact with each other. In fact, each unique method+uri can be a seperate thread. We can use a MVar to track the global max download count. Perhaps we also want a per host throttle, since it is the host connect that is likely to max out, not the access method. Plan: partition fetches by (host,method). fork off threads for each (host, method). Use MVar to throttle per host, and total connections We don't know if a method supports pipelining until we connect atleast once. So if we have a non-pipelined method, we might want to start multiple streams. On the other hand, for something like a CDROM, that will just cause the system to thrash. cdrom, file, etc, don't have a host, so that is not a unique key then. Pipelining on local methods is tricky, because it is hard to tell if the local methods point to the same device or not. Even though we have multiple threads, the interactor can view the incoming Stream as a single Stream because all the events are tagged with the URI (i think). But, sending commands involves a fancy router. We could include a reference to corresponding command for each stream. For now, let's serialize the transfers, but allow pipeling for methods that really allow pipelining. -} data FetchCallbacks = FetchCallbacks { logCB :: Message -> IO () , statusCB :: URI -> Message -> IO () , uriStartCB :: URI -> Maybe Integer -> Maybe UTCTime -> Maybe Integer -> IO () , uriDoneCB :: URI -> Maybe Integer -> Maybe UTCTime -> Maybe Integer -> Maybe FilePath -> Hashes -> Bool -> IO () , uriFailureCB :: URI -> Message -> IO () , generalFailureCB :: Message -> IO () , authorizationRequiredCB :: Site -> IO (Maybe (User, Password)) , mediaFailureCB :: Media -> Drive -> IO () , debugCB :: String -> IO () } simpleFetch :: [ConfigItem] -> URI -> FilePath -> Maybe UTCTime -> IO Bool simpleFetch = fetch cliFetchCallbacks -- |fetch a single item, show console output -- see also: getLastModified fetch :: FetchCallbacks -> [ConfigItem] -> URI -> FilePath -> Maybe UTCTime -> IO Bool fetch cb configItems uri fp lastModified = do withMethodURI uri $ \mh -> do s <- recvStatus mh debugCB cb ("<- " ++ show s) sendCommand' mh (URIAcquire uri fp lastModified) loop mh where sendCommand' mh c = do mapM_ (debugCB cb . ("-> " ++)) (formatCommand c) sendCommand mh c loop mh = do r <- recvStatus mh case r of Capabilities {} -> do unless (null configItems) (sendCommand' mh (Configuration configItems)) loop mh LogMsg m -> do logCB cb m loop mh Status uri m -> do statusCB cb uri m loop mh URIStart uri size lastModified resumePoint -> uriStartCB cb uri size lastModified resumePoint >> loop mh URIDone uri size lastModified resumePoint filename hashes imsHit -> uriDoneCB cb uri size lastModified resumePoint filename hashes imsHit >> return True URIFailure uri message -> uriFailureCB cb uri message >> return False GeneralFailure m -> generalFailureCB cb m >> return False AuthorizationRequired site -> do mCredentials <- authorizationRequiredCB cb site case mCredentials of Nothing -> return False -- FIXME: do we need a force close option for closeMethod ? Just (user, passwd) -> do sendCommand' mh (AuthorizationCredentials site user passwd) loop mh MediaFailure media drive -> do mediaFailureCB cb media drive return False -- |set of callbacks which do nothing. -- suitable for non-interactive usage. In the case authorization is -- required, no credentials will be supplied and the download should -- abort. emptyFetchCallbacks = FetchCallbacks { logCB = \ _m -> return () , statusCB = \ _uri _m -> return () , uriStartCB = \ _uri _size _lastModified _resumePoint -> return () , uriDoneCB = \ _uri _size _lastModified _resumePoint _filename _hashes _imsHit -> return () , uriFailureCB = \ _uri _message -> return () , generalFailureCB = \ _m -> return () , authorizationRequiredCB = \ _site -> return Nothing , mediaFailureCB = \ _media _drive -> return () , debugCB = \ _m -> return () } cliFetchCallbacks = emptyFetchCallbacks { statusCB = \uri m -> putStrLn $ uriToString' uri ++ " : " ++ m , uriStartCB = \ uri _size lastModified _resumePoint -> putStrLn $ uriToString' uri ++ " started. " ++ show lastModified , uriDoneCB = \uri _size _lastModified _resumePoint _filename _hashes imsHit -> putStrLn $ uriToString' uri ++ (if imsHit then " cached." else " downloaded.") , uriFailureCB = \uri message -> hPutStrLn stderr $ "URI Failure: " ++ uriToString' uri ++ " : " ++ message , generalFailureCB = \message -> hPutStrLn stderr $ "General Failure: " ++ message , authorizationRequiredCB = \site -> do putStrLn $ "Authorization Required for " ++ site putStrLn "Username: " >> hFlush stdout user <- getLine putStrLn "Password: " >> hFlush stdout passwd <- getLine -- TODO: write a getPasswd function which does not echo input return (Just (user, passwd)) , mediaFailureCB = \media drive -> hPutStrLn stderr $ "Media Failure: media=" ++ media ++" drive="++ drive , debugCB = \m -> print m } {- FetchCallbacks { logCB = \m -> hPutStrLn stderr m , statusCB = \uri m -> putStrLn (show uri ++" : "++ m) , uriStartCB = \uri } defaultAuthenticate site = do putStrLn $ "Authorization Required for " ++ site putStrLn "Username: " >> hFlush stdout user <- getLine putStrLn "Password: " >> hFlush stdout passwd <- getLine -- TODO: write a getPasswd function which does not echo input return (user, passwd) -} {- let itemsByHost = groupOn (regName . fst) items in do totalQSem <- newQSem 16 -- max number of streams allowed for forkIO where regName = fmap uriRegName . uriAuthority withQSem :: QSem -> IO a -> IO a withQSem qSem f = bracket (waitQSem qSem) (const $ signalQSem qSem) (const f) uris = map (fromJust . parseURI) [ "http://n-heptane.com/whee" , "file:/one/two/three" , "ssh://jeremy:aoeu@n-heptane.com" , "cdrom:/one" ] -} -- * Misc Helper Functions bool :: a -> a -> Bool -> a bool f _ False = f bool _ t True = t getLastModified :: FilePath -> IO (Maybe UTCTime) getLastModified fp = do e <- doesFileExist fp if e then getFileStatus fp >>= return . Just . epochTimeToUTCTime . modificationTime else return Nothing {- groupOn :: (Ord b) => (a -> b) -> [a] -> [[a]] groupOn f = groupBy ((==) `on` f) . sortBy (compare `on` f) on :: (a -> a -> b) -> (c -> a) -> c -> c -> b on f g x y = f (g x) (g y) -} cabal-debian-4.31/debian-haskell/Debian/Apt/Index.hs0000644000000000000000000003353412565162075020306 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, OverloadedStrings, ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-orphans #-} module Debian.Apt.Index ( update , Fetcher , CheckSums(..) , Compression(..) , FileTuple , Size , controlFromIndex , controlFromIndex' , findContentsFiles , findIndexes , indexesInRelease , tupleFromFilePath ) where import Control.Monad import qualified Codec.Compression.GZip as GZip import qualified Codec.Compression.BZip as BZip import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.Digest.Pure.MD5 as MD5 import Data.Function import Data.List as List (null, intercalate, sortBy, isSuffixOf, isPrefixOf) import qualified Data.Map as M import Data.Monoid ((<>)) import Data.Text as Text (Text, unpack, concat, lines, null, words) import Data.Time import Debian.Apt.Methods import Debian.Control (formatControl) import Debian.Control.ByteString import Debian.Control.Common import Debian.Control.Text (decodeControl) import Debian.Release import Debian.Sources import Debian.URI import System.Directory import System.FilePath (()) import System.Posix.Files import System.FilePath (takeBaseName) --import qualified System.Unix.Misc as Misc import Text.ParserCombinators.Parsec.Error import Text.PrettyPrint (render) import Text.PrettyPrint.HughesPJClass (pPrint) -- |Package indexes on the server are uncompressed or compressed with -- gzip or bzip2. We do not know what will exist on the server until we -- actually look. This type is used to mark the compression status of -- what was actually found. data Compression = BZ2 | GZ | Uncompressed deriving (Read, Show, Eq, Ord, Enum, Bounded) data CheckSums = CheckSums { md5sum :: Maybe String , sha1 :: Maybe String , sha256 :: Maybe String } deriving (Read, Show, Eq) -- |function-type for a function that downloads a file -- The timestamp is optional. If the local file is as new or newer -- than the remote copy, the download may be skipped. -- -- A good choice might be a partially parameterized call to -- 'Debian.Apt.Methods.fetch' type Fetcher = URI -> -- remote URI FilePath -> -- local file name Maybe UTCTime -> -- optional time stamp for local file IO Bool -- True on success, False on failure -- |update - similar to apt-get update -- downloads the index files associated with a sources.list. The -- downloaded index files will have the same basenames that apt-get uses -- in \/var\/lib\/apt\/lists. You can almost use this function instead of -- calling apt-get update. However there are a few key differences: -- 1. apt-get update also updates the binary cache files -- 2. apt-get update uses the partial directory and lock file in\ /var\/lib\/apt\/lists -- 3. apt-get update downloads the Release and Release.gpg files update :: Fetcher -- ^ function that will do actually downloading -> FilePath -- ^ download indexes to the directory (must already exist) -> String -- ^ binary architecture -> [DebSource] -- ^ sources.list -> IO [Maybe (FilePath, Compression)] -- ^ (basename of index file, compression status) update fetcher basePath arch sourcesList = mapM (uncurry $ fetchIndex fetcher) (map (\(uri, fp, _) -> (uri, (basePath fp))) (concatMap (indexURIs arch) sourcesList)) -- | download possibly compressed files -- NOTE: index uri must not include the .bz2 or .gz extension fetchIndex :: Fetcher -- ^ function that will do the actual fetch -> URI -- ^ remote URI of package index, without .bz2 or .gz extension -> FilePath -- ^ name to save downloaded file as, without .bz2 or .gz extension -> IO (Maybe (FilePath, Compression)) -- ^ (downloaded file name + extension, compression status) fetchIndex fetcher uri localPath = do let localPath' = localPath ++ ".bz2" --lm <- getLastModified localPath' res <- fetcher (uri { uriPath = (uriPath uri) ++ ".bz2" }) localPath' Nothing if res then return $ Just (localPath', BZ2) else do let localPath' = localPath ++ ".gz" lm <- getLastModified localPath' res <- fetcher (uri { uriPath = (uriPath uri) ++ ".gz" }) localPath' lm if res then return $ Just (localPath', GZ) else do lm <- getLastModified localPath res <- fetcher (uri { uriPath = (uriPath uri) }) localPath lm if res then return (Just (localPath, Uncompressed)) else return Nothing -- |examine a DebSource line, and calculate for each section: -- - the URI to the uncompressed index file -- - the basename that apt-get would name the downloaded index -- FIXME: ExactPath dist will fail with error at runtime :( indexURIs :: String -- ^ which binary architecture -> DebSource -- ^ line from sources.list -> [(URI, FilePath, DebSource)] -- ^ (remote uri, local name, deb source for just this section) indexURIs arch debSource = map (\ section -> let (uri, fp) = calcPath (sourceType debSource) arch baseURI release section in (uri,fp, debSource { sourceDist = (Right (release, [section])) }) ) sections where baseURI = sourceUri debSource (release, sections) = either (error $ "indexURIs: support not implemented for exact path: " ++ render (pPrint debSource)) id (sourceDist debSource) -- |return a tuple for the section -- - the URI to the uncompressed index file -- - the basename that apt-get uses for the downloaded index -- FIXME: support for Release and Release.gpg calcPath :: SourceType -- ^ do we want Packages or Sources -> String -- ^ The binary architecture to use for Packages -> URI -- ^ base URI as it appears in sources.list -> ReleaseName -- ^ the release (e.g., unstable, testing, stable, sid, etc) -> Section -- ^ the section (main, contrib, non-free, etc) -> (URI, [Char]) -- ^ (uri to index file, basename for the downloaded file) calcPath srcType arch baseURI release section = let indexPath = case srcType of DebSrc -> "source/Sources" Deb -> "binary-" ++ arch "Packages" path = (uriPath baseURI) "dists" (releaseName' release) sectionName' section indexPath in (baseURI { uriPath = path }, addPrefix . escapePath $ path) where addPrefix s = prefix scheme user' pass' reg port ++ {- "_" ++ -} s prefix "http:" (Just user) Nothing (Just host) port = user ++ host ++ port prefix "http:" _ _ (Just host) port = host ++ port prefix "ftp:" _ _ (Just host) _ = host prefix "file:" Nothing Nothing Nothing "" = "" prefix "ssh:" (Just user) Nothing (Just host) port = user ++ host ++ port prefix "ssh:" _ _ (Just host) port = host ++ port prefix _ _ _ _ _ = error ("calcPath: unsupported uri: " ++ uriToString' baseURI) user' = maybeOfString user pass' = maybeOfString pass (user, pass) = break (== ':') userpass userpass = maybe "" uriUserInfo auth reg = maybeOfString $ maybe "" uriRegName auth port = maybe "" uriPort auth scheme = uriScheme baseURI auth = uriAuthority baseURI --path = uriPath baseURI escapePath :: String -> String escapePath s = intercalate "_" $ wordsBy (== '/') s maybeOfString :: String -> Maybe String maybeOfString "" = Nothing maybeOfString s = Just s wordsBy :: Eq a => (a -> Bool) -> [a] -> [[a]] wordsBy p s = case (break p s) of (s, []) -> [s] (h, t) -> h : wordsBy p (drop 1 t) -- |Parse a possibly compressed index file. controlFromIndex :: Compression -> FilePath -> L.ByteString -> Either ParseError (Control' Text) controlFromIndex GZ path s = either Left (Right . decodeControl) . parseControl path . B.concat . L.toChunks . GZip.decompress $ s controlFromIndex BZ2 path s = either Left (Right . decodeControl) . parseControl path . B.concat . L.toChunks . BZip.decompress $ s controlFromIndex Uncompressed path s = either Left (Right . decodeControl) . parseControl path . B.concat . L.toChunks $ s -- |parse an index possibly compressed file controlFromIndex' :: Compression -> FilePath -> IO (Either ParseError (Control' Text)) controlFromIndex' compression path = L.readFile path >>= return . controlFromIndex compression path type Size = Integer type FileTuple = (CheckSums, Size, FilePath) -- |A release file contains a list of indexes (Packages\/Sources). Each -- Package or Source index may appear multiple times because it may be -- compressed several different ways. This function will return an -- assoc list where the key is the name of the uncompressed package -- index name and the value is the list of (file, compression) which -- decompress to the key. groupIndexes :: [FileTuple] -> [(FilePath, [(FileTuple, Compression)])] groupIndexes indexFiles = M.toList $ M.fromListWith combine $ map makeKV indexFiles where makeKV fileTuple@(_,_,fp) = let (name, compressionMethod) = uncompressedName fp in (name, [(fileTuple, compressionMethod)]) combine = (\x y -> sortBy (compare `on` snd) (x ++ y)) {- with t@(_,_,fp) m = let (un, compression) = in M.insertWith -} {- groupIndexes' :: String ->[FileTuple] -> [(FilePath, [(FileTuple, Compression)])] groupIndexes' iType indexFiles = M.toList (foldr (insertType iType) M.empty indexFiles) where insertType iType t@(_,_,fp) m = case uncompressedName' iType fp of Nothing -> m (Just (un, compression)) -> M.insertWith (\x y -> sortBy (compare `on` snd) (x ++ y)) un [(t, compression)] m -} -- |The release file contains the checksums for the uncompressed -- package indexes, even if the uncompressed package indexes are not -- stored on the server. This function returns the list of files that -- actually exist. filterExists :: FilePath -> (FilePath, [(FileTuple, Compression)]) -> IO (FilePath, [(FileTuple, Compression)]) filterExists distDir (fp, alternatives) = do e <- filterM ( \((_,_,fp),_) -> fileExist (distDir fp)) alternatives -- when (null e) (error $ "None of these files exist: " ++ show alternatives) return (fp, e) findIndexes :: FilePath -> String -> [FileTuple] -> IO [(FileTuple, Compression)] findIndexes distDir iType controlFiles = let indexes = groupIndexes controlFiles in do indexes' <- mapM (filterExists distDir) (filter (isType iType) indexes) return $ map (head . snd) (filter (not . List.null . snd) indexes') where isType iType (fp, _) = iType `isSuffixOf` fp {- findIndexes' :: FilePath -> String -> [FileTuple] -> IO [(FileTuple, Compression)] findIndexes' distDir iType controlFiles = let m = groupIndexes' iType controlFiles in do m' <- mapM (filterExists distDir) m return $ map (head . snd) (filter (not . null . snd) m') -} -- insertType :: String -> (CheckSums, Integer, FilePath) -> M.Map FilePath ((CheckSums, Integer, FilePath), Compression) -> M.Map FilePath ((CheckSums, Integer, FilePath), Compression) {- uncompressedName' :: String -> FilePath -> Maybe (FilePath, Compression) uncompressedName' iType fp | isSuffixOf iType fp = Just (fp, Uncompressed) | isSuffixOf (iType ++".gz") fp = Just (reverse . (drop 3) . reverse $ fp, GZ) | isSuffixOf (iType ++".bz2") fp = Just (reverse . (drop 4) . reverse $ fp, BZ2) | otherwise = Nothing -} uncompressedName :: FilePath -> (FilePath, Compression) uncompressedName fp | isSuffixOf ".gz" fp = (reverse . (drop 3) . reverse $ fp, GZ) | isSuffixOf ".bz2" fp = (reverse . (drop 4) . reverse $ fp, BZ2) | otherwise = (fp, Uncompressed) indexesInRelease :: (FilePath -> Bool) -> Control' Text -- ^ A release file -> [(CheckSums, Integer, FilePath)] -- ^ indexesInRelease filterp (Control [p]) = let md5sums = case md5sumField p of (Just md5) -> md5 Nothing -> error $ "Did not find MD5Sum field." in filter (\(_,_,fp) -> filterp fp) $ map (makeTuple . Text.words) $ filter (not . Text.null) (Text.lines md5sums) where makeTuple :: [Text] -> (CheckSums, Integer, FilePath) makeTuple [md5sum, size, fp] = (CheckSums { md5sum = Just (Text.unpack md5sum), sha1 = Nothing, sha256 = Nothing }, read (Text.unpack size), Text.unpack fp) makeTuple x = error $ "Invalid line in release file: " ++ show x indexesInRelease _ x = error $ "Invalid release file: " <> Text.unpack (Text.concat (formatControl x)) -- |make a FileTuple for a file found on the local disk -- returns 'Nothing' if the file does not exist. tupleFromFilePath :: FilePath -> FilePath -> IO (Maybe FileTuple) tupleFromFilePath basePath fp = do e <- fileExist (basePath fp) if not e then return Nothing else do size <- getFileStatus (basePath fp) >>= return . fromIntegral . fileSize md5 <- L.readFile (basePath fp) >>= return . show . MD5.md5 return $ Just (CheckSums { md5sum = Just md5, sha1 = Nothing, sha256 = Nothing }, size, fp) -- |find the Contents-* files. These are not listed in the Release file findContentsFiles :: (FilePath -> Bool) -> FilePath -> IO [FilePath] findContentsFiles filterP distDir = do files <- getDirectoryContents distDir return $ filter filterP $ filter (isPrefixOf "Contents-" . takeBaseName) files cabal-debian-4.31/debian-haskell/Debian/Apt/Dependencies.hs0000644000000000000000000002376612565162075021633 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS -fno-warn-missing-signatures #-} module Debian.Apt.Dependencies {- ( solve , State , binaryDepends , search , bj' , bt , CSP(..) ) -} where -- test gutsyPackages "libc6" (\csp -> bt csp) import Control.Arrow (second) import qualified Data.ByteString.Char8 as C import Data.List as List (find, union) import Data.Tree(Tree(rootLabel, Node)) import Debian.Apt.Package(PackageNameMap, packageNameMap, lookupPackageByRel) import Debian.Control.ByteString(ControlFunctions(stripWS, lookupP, parseControlFromFile), Field'(Field, Comment), Control'(Control), Paragraph, Control) import Debian.Relation (BinPkgName(..)) import Debian.Relation.ByteString(ParseRelations(..), Relation(..), OrRelation, AndRelation, Relations, checkVersionReq) import Debian.Version(DebianVersion, parseDebianVersion, prettyDebianVersion) import Text.PrettyPrint (render) -- * Basic CSP Types and Functions data Status = Remaining AndRelation | MissingDep Relation | Complete deriving (Eq) type State a = (Status, [a]) complete :: State a -> Bool complete (Complete, _) = True complete _ = False data CSP a = CSP { pnm :: PackageNameMap a , relations :: Relations , depFunction :: (a -> Relations) , conflicts :: a -> Relations , packageVersion :: a -> (BinPkgName, DebianVersion) } -- * Test CSP -- |TODO addProvides -- see DQL.Exec controlCSP :: Control -> Relations -> (Paragraph -> Relations) -> CSP Paragraph controlCSP (Control paragraphs) rels depF' = CSP { pnm = packageNameMap getName paragraphs , relations = rels , depFunction = depF' , conflicts = conflicts' , packageVersion = packageVersionParagraph } where getName :: Paragraph -> BinPkgName getName p = case lookupP "Package" p of Nothing -> error "Missing Package field" Just (Field (_,n)) -> BinPkgName (C.unpack (stripWS n)) Just (Comment _) -> error "controlCSP" conflicts' :: Paragraph -> Relations conflicts' p = case lookupP "Conflicts" p of Nothing -> [] Just (Field (_, c)) -> either (error . show) id (parseRelations c) Just (Comment _) -> error "controlCSP" testCSP :: FilePath -> (Paragraph -> Relations) -> String -> (CSP Paragraph -> IO a) -> IO a testCSP controlFile depf relationStr cspf = do c' <- parseControlFromFile controlFile case c' of Left e -> error (show e) Right control@(Control _) -> case parseRelations relationStr of Left e -> error (show e) Right r -> cspf (controlCSP control r depf) depF :: Paragraph -> Relations depF p = let preDepends = case lookupP "Pre-Depends" p of Nothing -> [] Just (Field (_,pd)) -> either (error . show) id (parseRelations pd) Just (Comment _) -> error "depF" depends = case lookupP "Depends" p of Nothing -> [] Just (Field (_,pd)) -> either (error . show) id (parseRelations pd) Just (Comment _) -> error "depF" in preDepends ++ depends sidPackages = "/var/lib/apt/lists/ftp.debian.org_debian_dists_unstable_main_binary-i386_Packages" gutsyPackages = "/var/lib/apt/lists/mirror.anl.gov_pub_ubuntu_dists_gutsy_main_binary-i386_Packages" test controlFP rel labeler = testCSP controlFP depF rel (mapM_ (\ (_,p) -> mapM_ (print . second (render . prettyDebianVersion) . packageVersionParagraph) p ) . take 1 . search labeler) -- TODO: add better errors packageVersionParagraph :: Paragraph -> (BinPkgName, DebianVersion) packageVersionParagraph p = case lookupP "Package" p of Nothing -> error $ "Paragraph missing Package field" (Just (Field (_, name))) -> case lookupP "Version" p of Nothing -> error $ "Paragraph missing Version field" (Just (Field (_, version))) -> (BinPkgName (C.unpack (stripWS name)), parseDebianVersion (C.unpack version)) (Just (Comment _)) -> error "packageVersionParagraph" (Just (Comment _)) -> error "packageVersionParagraph" conflict :: CSP p -> p -> p -> Bool conflict csp p1 p2 = let (name1, version1) = (packageVersion csp) p1 (name2, version2) = (packageVersion csp) p2 in if name1 == name2 then version1 /= version2 else any (conflict' (name1, version1)) (concat $ (conflicts csp) p2) || any (conflict' (name2, version2)) (concat $ (conflicts csp) p1) -- |JAS: deal with 'Provides' (can a package provide more than one package?) conflict' :: (BinPkgName, DebianVersion) -> Relation -> Bool conflict' (pName, pVersion) (Rel pkgName mVersionReq _) = (pName == pkgName) && (checkVersionReq mVersionReq (Just pVersion)) -- * Tree Helper Functions mkTree :: a -> [Tree a] -> Tree a mkTree = Node label :: Tree a -> a label = rootLabel initTree :: (a -> [a]) -> a -> Tree a initTree f a = Node a (map (initTree f) (f a)) mapTree :: (a -> b) -> Tree a -> Tree b mapTree = fmap foldTree :: (a -> [b] -> b) -> Tree a -> b foldTree f (Node a ts) = f a (map (foldTree f) ts) zipTreesWith :: (a -> b -> c) -> Tree a -> Tree b -> Tree c zipTreesWith f (Node a ts) (Node b us) = Node (f a b) (zipWith (zipTreesWith f) ts us) prune :: (a -> Bool) -> Tree a -> Tree a prune p = foldTree f where f a ts = Node a (filter (not . p . label) ts) leaves :: Tree a -> [a] leaves = foldTree f where f leaf [] = [leaf] f _ ts = concat ts inhTree :: (b -> a -> b) -> b -> Tree a -> Tree b inhTree f b (Node a ts) = Node b' (map (inhTree f b') ts) where b' = f b a distrTree :: (a -> [b]) -> b -> Tree a -> Tree b distrTree f b (Node a ts) = Node b (zipWith (distrTree f) (f a) ts) -- * mkSearchTree -- TODO: might want to leave markers about what relation we are satisfying? mkSearchTree :: forall a. CSP a -> Tree (State a) mkSearchTree csp = Node (Remaining (relations csp),[]) (andRelation ([],[]) (relations csp)) where andRelation :: ([a],AndRelation) -> AndRelation -> [Tree (State a)] andRelation (candidates,[]) [] = [Node (Complete, candidates) []] andRelation (candidates,remaining) [] = andRelation (candidates, []) remaining andRelation (candidates, remaining) (x:xs) = orRelation (candidates, xs ++ remaining) x orRelation :: ([a],AndRelation) -> OrRelation -> [Tree (State a)] orRelation acc x = concat (fmap (relation acc) x) relation :: ([a],AndRelation) -> Relation -> [Tree (State a)] relation acc@(candidates,_) rel = let packages = lookupPackageByRel (pnm csp) (packageVersion csp) rel in case packages of [] -> [Node (MissingDep rel, candidates) []] _ -> map (package acc) packages package :: ([a],AndRelation) -> a -> Tree (State a) package (candidates, remaining) p = if ((packageVersion csp) p) `elem` (map (packageVersion csp) candidates) then if null remaining then Node (Complete, candidates) [] else Node (Remaining remaining, candidates) (andRelation (candidates, []) remaining) else Node (Remaining remaining, (p : candidates)) (andRelation ((p : candidates), remaining) ((depFunction csp) p)) -- |earliestInconsistency does what it sounds like -- the 'reverse as' is because the vars are order high to low, but we -- want to find the lowest numbered (aka, eariest) inconsistency ?? -- earliestInconsistency :: CSP a -> State a -> Maybe ((BinPkgName, DebianVersion), (BinPkgName, DebianVersion)) earliestInconsistency _ (_,[]) = Nothing earliestInconsistency _ (_,[_p]) = Nothing earliestInconsistency csp (_,(p:ps)) = case find ((conflict csp) p) (reverse ps) of Nothing -> Nothing (Just conflictingPackage) -> Just ((packageVersion csp) p, (packageVersion csp) conflictingPackage) -- * Conflict Set -- | conflicting packages and relations that require non-existant packages type ConflictSet = ([(BinPkgName, DebianVersion)],[Relation]) isConflict :: ConflictSet -> Bool isConflict ([],[]) = False isConflict _ = True solutions :: Tree (State a, ConflictSet) -> [State a] solutions = filter complete . map fst . leaves . prune (isConflict . snd) type Labeler a = CSP a -> Tree (State a) -> Tree (State a, ConflictSet) search :: Labeler a -> CSP a -> [State a] search labeler csp = (solutions . (labeler csp) . mkSearchTree) csp -- * Backtracking Labeler bt :: Labeler a bt csp = mapTree f where f s@(status,_) = case status of (MissingDep rel) -> (s, ([], [rel])) _ -> (s, case (earliestInconsistency csp) s of Nothing -> ([],[]) Just (a,b) -> ([a,b], [])) -- * BackJumping Solver {-|bj - backjumping labeler If the node already has a conflict set, then leave it alone. Otherwise, the conflictset for the node is the combination of the conflict sets of its direct children. -} bj :: CSP p -> Tree (State p, ConflictSet) -> Tree (State p, ConflictSet) bj csp = foldTree f where f (s, cs) ts | isConflict cs = mkTree (s, cs) ts -- | isConflict cs' = mkTree (s, cs') [] -- prevent space leak | otherwise = mkTree (s, cs') ts where cs' = let set = combine csp (map label ts) [] in set `seq` set -- prevent space leak unionCS :: [ConflictSet] -> ConflictSet unionCS css = foldr (\(c1, m1) (c2, m2) -> ((c1 `union` c2), (m1 `union` m2))) ([],[]) css combine :: CSP p -> [(State p, ConflictSet)] -> [ConflictSet] -> ConflictSet combine _ [] acc = unionCS acc combine csp ((s,cs@(c,m)):ns) acc | (not (lastvar `elem` c)) && null m = cs | null c && null m = ([],[]) -- is this case ever used? | otherwise = combine csp ns ((c, m):acc) where lastvar = let (_,(p:_)) = s in (packageVersion csp) p cabal-debian-4.31/debian-haskell/Debian/Apt/Package.hs0000644000000000000000000000453612565162075020572 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} -- |Functions for dealing with source and binary packages in an abstract-way module Debian.Apt.Package where -- Standard GHC Modules import qualified Data.Map as Map -- Local Modules import Debian.Version import Debian.Relation type PackageNameMap a = Map.Map BinPkgName [a] -- |'packageNameMap' creates a map from a package name to all the versions of that package -- NOTE: Provides are not included in the map -- NOTE: the sort order is random -- this is perhaps a bug -- see also: 'addProvides' packageNameMap :: (a -> BinPkgName) -> [a] -> PackageNameMap a packageNameMap getName packages = foldl (\m p -> Map.insertWith (++) (getName p) [p] m) Map.empty packages -- |'addProvides' finds packages that Provide other packages and adds -- them to the PackageNameMap. They will be adde to the end of the -- list, so that real packages have 'higher priority' than virtual -- packages. -- NOTE: Does not check for duplication or multiple use addProvides :: (p -> [BinPkgName]) -> [p] -> PackageNameMap p -> PackageNameMap p addProvides providesf ps pnm = let provides = findProvides providesf ps in foldl (\m (packageName, package) -> Map.insertWith (flip (++)) packageName [package] m) pnm provides -- |'findProvides' findProvides :: forall p. (p -> [BinPkgName]) -> [p] -> [(BinPkgName, p)] findProvides providesf packages = foldl addProvides' [] packages where addProvides' :: [(BinPkgName, p)] -> p -> [(BinPkgName, p)] addProvides' providesList package = foldl (\pl pkgName -> (pkgName, package): pl) providesList (providesf package) -- |'lookupPackageByRel' returns all the packages that satisfy the specified relation -- TODO: Add architecture check lookupPackageByRel :: PackageNameMap a -> (a -> (BinPkgName, DebianVersion)) -> Relation -> [a] lookupPackageByRel pm packageVersionF (Rel pkgName mVerReq _mArch) = case Map.lookup pkgName pm of Nothing -> [] Just packages -> filter filterVer packages where filterVer p = case mVerReq of Nothing -> True Just _verReq -> let (pName, pVersion) = packageVersionF p in if pName /= pkgName then False -- package is a virtual package, hence we can not do a version req else checkVersionReq mVerReq (Just pVersion) cabal-debian-4.31/debian-haskell/Debian/Extra/0000755000000000000000000000000012565162075017232 5ustar0000000000000000cabal-debian-4.31/debian-haskell/Debian/Extra/Files.hs0000644000000000000000000000227412565162075020635 0ustar0000000000000000{-# LANGUAGE PackageImports #-} -- |Domain independent functions used by the haskell-debian package. module Debian.Extra.Files ( withTemporaryFile ) where import "mtl" Control.Monad.Trans (MonadIO, liftIO) import System.Directory (getTemporaryDirectory, removeFile) import System.IO (hPutStr, hClose, openBinaryTempFile) withTemporaryFile :: MonadIO m => (FilePath -> m a) -- ^ The function we want to pass a FilePath to -> String -- ^ The text that the file should contain -> m a -- ^ The function's return value withTemporaryFile f text = do path <- liftIO writeTemporaryFile result <- f path liftIO $ removeFile path return result where writeTemporaryFile = do dir <- getTemporaryDirectory (path, h) <- openBinaryTempFile dir "wtf.tmp" hPutStr h text hClose h return path -- Example: write the path of the temporary file and its contents into /tmp/result: -- test = -- withTemporaryFile f "Some text\n" -- where f path = readFile path >>= return . (("Contents of " ++ path ++ ":\n") ++) >>= writeFile "/tmp/result" cabal-debian-4.31/debian-haskell/Debian/Control/0000755000000000000000000000000012565162075017567 5ustar0000000000000000cabal-debian-4.31/debian-haskell/Debian/Control/Common.hs0000644000000000000000000001711612565162075021361 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, FlexibleInstances, OverloadedStrings, ScopedTypeVariables, UndecidableInstances #-} module Debian.Control.Common ( -- * Types Control'(..) , Paragraph'(..) , Field'(..) , ControlFunctions(..) , mergeControls , fieldValue , removeField , prependFields , appendFields , renameField , modifyField , raiseFields , parseControlFromCmd , md5sumField , protectFieldText' ) where import Data.Char (isSpace) import Data.List as List (dropWhileEnd, partition, intersperse) import Data.ListLike as LL (ListLike, cons, dropWhileEnd, empty, find, null, singleton) import Data.ListLike.String as LL (StringLike, lines, unlines) import Data.Monoid ((<>)) import Debian.Pretty (PP(..)) import System.Exit (ExitCode(ExitSuccess, ExitFailure)) import System.IO (Handle) import System.Process (runInteractiveCommand, waitForProcess) import Text.ParserCombinators.Parsec (ParseError) import Text.PrettyPrint (Doc, text, hcat) import Text.PrettyPrint.HughesPJClass (Pretty(pPrint)) newtype Control' a = Control { unControl :: [Paragraph' a] } deriving (Eq, Ord, Read, Show) newtype Paragraph' a = Paragraph [Field' a] deriving (Eq, Ord, Read, Show) -- |NOTE: we do not strip the leading or trailing whitespace in the -- name or value data Field' a = Field (a, a) | Comment a -- ^ Lines beginning with # deriving (Eq, Ord, Read, Show) class ControlFunctions a where -- |'parseControlFromFile' @filepath@ is a simple wrapper function -- that parses @filepath@ using 'pControl' parseControlFromFile :: FilePath -> IO (Either ParseError (Control' a)) -- |'parseControlFromHandle' @sourceName@ @handle@ - @sourceName@ is only used for error reporting parseControlFromHandle :: String -> Handle -> IO (Either ParseError (Control' a)) -- |'parseControlFromString' @sourceName@ @text@ - @sourceName@ is only used for error reporting parseControl :: String -> a -> (Either ParseError (Control' a)) -- | 'lookupP' @fieldName paragraph@ looks up a 'Field' in a 'Paragraph'. -- @N.B.@ trailing and leading whitespace is /not/ stripped. lookupP :: String -> (Paragraph' a) -> Maybe (Field' a) -- |Strip the trailing and leading space and tab characters from a -- string. Folded whitespace is /not/ unfolded. This should probably -- be moved to someplace more general purpose. stripWS :: a -> a -- |Protect field value text so the parser doesn't split it into -- multiple fields or paragraphs. This must modify all field text -- to enforce two conditions: (1) All lines other than the initial -- one must begin with a space or a tab, and (2) the trailing -- white space must not contain newlines. This is called before -- pretty printing to prevent the parser from misinterpreting -- field text as multiple fields or paragraphs. protectFieldText :: a -> a asString :: a -> String -- | This can usually be used as the implementation of protectFieldText protectFieldText' :: forall a. (StringLike a, ListLike a Char) => ControlFunctions a => a -> a protectFieldText' s = let trimmedLines :: [a] trimmedLines = map (LL.dropWhileEnd isSpace :: a -> a) $ (LL.lines s :: [a]) strippedLines :: [a] strippedLines = List.dropWhileEnd LL.null trimmedLines in -- Split the text into lines, drop trailing whitespace from each -- line, and drop trailing blank lines. case strippedLines of [] -> empty (l : ls) -> let -- The first line is indented one space l' = {-LL.cons ' '-} l -- Null lines are replaced by a single '.' If any line -- is unindented, all will get an additional space of -- indentation. ls' = case all indented ls of True -> map (\ x -> if LL.null x then (LL.cons ' ' $ singleton '.') else x) ls False -> map (LL.cons ' ') $ map (\ x -> if LL.null x then (singleton '.') else x) ls in LL.dropWhileEnd isSpace (LL.unlines (l' : ls')) where indented l = maybe True isSpace (LL.find (const True) l) -- | This may have bad performance issues (dsf: Whoever wrote this -- comment should have explained why.) instance (ControlFunctions a, Pretty (PP a)) => Pretty (Control' a) where pPrint = ppControl instance (ControlFunctions a, Pretty (PP a)) => Pretty (Paragraph' a) where pPrint = ppParagraph instance (ControlFunctions a, Pretty (PP a)) => Pretty (Field' a) where pPrint = ppField ppControl :: (ControlFunctions a, Pretty (PP a)) => Control' a -> Doc ppControl (Control paragraph) = hcat (intersperse (text "\n") (map ppParagraph paragraph)) ppParagraph :: (ControlFunctions a, Pretty (PP a)) => Paragraph' a -> Doc ppParagraph (Paragraph fields) = hcat (map (\ x -> ppField x <> text "\n") fields) ppField :: (ControlFunctions a, Pretty (PP a)) => Field' a -> Doc ppField (Field (n,v)) = pPrint (PP n) <> text ":" <> pPrint (PP (protectFieldText v)) ppField (Comment c) = pPrint (PP c) mergeControls :: [Control' a] -> Control' a mergeControls controls = Control (concatMap unControl controls) fieldValue :: (ControlFunctions a) => String -> Paragraph' a -> Maybe a fieldValue fieldName paragraph = case lookupP fieldName paragraph of Just (Field (_, val)) -> Just $ stripWS val _ -> Nothing removeField :: (Eq a) => a -> Paragraph' a -> Paragraph' a removeField toRemove (Paragraph fields) = Paragraph (filter remove fields) where remove (Field (name,_)) = name == toRemove remove (Comment _) = False prependFields :: [Field' a] -> Paragraph' a -> Paragraph' a prependFields newfields (Paragraph fields) = Paragraph (newfields ++ fields) appendFields :: [Field' a] -> Paragraph' a -> Paragraph' a appendFields newfields (Paragraph fields) = Paragraph (fields ++ newfields) renameField :: (Eq a) => a -> a -> Paragraph' a -> Paragraph' a renameField oldname newname (Paragraph fields) = Paragraph (map rename fields) where rename (Field (name, value)) | name == oldname = Field (newname, value) rename field = field modifyField :: (Eq a) => a -> (a -> a) -> Paragraph' a -> Paragraph' a modifyField name f (Paragraph fields) = Paragraph (map modify fields) where modify (Field (name', value)) | name' == name = Field (name, f value) modify field = field -- | Move selected fields to the beginning of a paragraph. raiseFields :: (Eq a) => (a -> Bool) -> Paragraph' a -> Paragraph' a raiseFields f (Paragraph fields) = let (a, b) = partition f' fields in Paragraph (a ++ b) where f' (Field (name, _)) = f name f' (Comment _) = False -- | Run a command and parse its output as a control file. parseControlFromCmd :: ControlFunctions a => String -> IO (Either String (Control' a)) parseControlFromCmd cmd = do (_, outh, _, handle) <- runInteractiveCommand cmd result <- parseControlFromHandle cmd outh either (return . Left . show) (finish handle) result where finish handle control = do exitCode <- waitForProcess handle case exitCode of ExitSuccess -> return $ Right control ExitFailure n -> return $ Left ("Failure: " ++ cmd ++ " -> " ++ show n) -- |look up the md5sum file in a paragraph -- Tries several different variations: -- MD5Sum: -- Md5Sum: -- MD5sum: md5sumField :: (ControlFunctions a) => Paragraph' a -> Maybe a md5sumField p = case fieldValue "MD5Sum" p of m@(Just _) -> m Nothing -> case fieldValue "Md5Sum" p of m@(Just _) -> m Nothing -> fieldValue "MD5sum" p cabal-debian-4.31/debian-haskell/Debian/Control/Text.hs0000644000000000000000000001336412565162075021056 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, OverloadedStrings, ScopedTypeVariables, TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-name-shadowing -fno-warn-unused-do-bind #-} module Debian.Control.Text ( -- * Types Control'(..) , Paragraph'(..) , Field'(..) , Control , Paragraph , Field -- , ControlParser , ControlFunctions(..) -- * Control File Parser -- , pControl -- * Helper Functions , mergeControls , fieldValue , removeField , prependFields , appendFields , renameField , modifyField , raiseFields , decodeControl , decodeParagraph , decodeField ) where import qualified Data.ByteString.Char8 as B import Data.Char (toLower, chr) import Data.List (find) import qualified Data.Text as T (Text, pack, unpack, map, dropAround, reverse) import Data.Text.Encoding (decodeUtf8With, encodeUtf8) --import Data.Text.IO as T (readFile) import qualified Debian.Control.ByteString as B --import Text.Parsec.Error (ParseError) --import Text.Parsec.Text (Parser) --import Text.Parsec.Prim (runP) import Debian.Control.Common (ControlFunctions(parseControlFromFile, parseControlFromHandle, parseControl, lookupP, stripWS, asString), Control'(Control), Paragraph'(Paragraph), Field'(Field, Comment), mergeControls, fieldValue, removeField, prependFields, appendFields, renameField, modifyField, raiseFields, protectFieldText') -- | @parseFromFile p filePath@ runs a string parser @p@ on the -- input read from @filePath@ using 'Prelude.readFile'. Returns either a 'ParseError' -- ('Left') or a value of type @a@ ('Right'). -- -- > main = do{ result <- parseFromFile numbers "digits.txt" -- > ; case result of -- > Left err -> print err -- > Right xs -> print (sum xs) -- > } {- parseFromFile :: Parser a -> String -> IO (Either ParseError a) parseFromFile p fname = do input <- T.readFile fname `E.catch` (\ (_ :: E.SomeException) -> B.readFile fname >>= return . decode) return (runP p () fname input) -} type Field = Field' T.Text type Control = Control' T.Text type Paragraph = Paragraph' T.Text decodeControl :: B.Control -> Control decodeControl (B.Control paragraphs) = Control (map decodeParagraph paragraphs) decodeParagraph :: B.Paragraph -> Paragraph decodeParagraph (B.Paragraph s) = B.Paragraph (map decodeField s) decodeField :: Field' B.ByteString -> Field' T.Text decodeField (B.Field (name, value)) = Field (decode name, decode value) decodeField (B.Comment s) = Comment (decode s) decode :: B.ByteString -> T.Text decode = decodeUtf8With (\ _ w -> fmap (chr . fromIntegral) w) -- * ControlFunctions instance ControlFunctions T.Text where parseControlFromFile filepath = -- The ByteString parser is far more efficient than the Text -- parser. By calling decodeControl we tell the compiler to -- use it instead. parseControlFromFile filepath >>= return . either Left (Right . decodeControl) parseControlFromHandle sourceName handle = parseControlFromHandle sourceName handle >>= return . either Left (Right . decodeControl) parseControl sourceName c = -- Warning: This is very slow, it does a utf8 round trip either Left (Right . decodeControl) (parseControl sourceName (encodeUtf8 c)) lookupP fieldName (Paragraph paragraph) = find (hasFieldName (map toLower fieldName)) paragraph where hasFieldName :: String -> Field' T.Text -> Bool hasFieldName name (Field (fieldName',_)) = T.pack name == T.map toLower fieldName' hasFieldName _ _ = False stripWS = T.dropAround (`elem` (" \t" :: String)) -- T.strip would also strip newlines protectFieldText = protectFieldText' asString = T.unpack -- * Control File Parser {- -- type ControlParser = GenParser T.Text type ControlParser a = Parsec T.Text () a -- |A parser for debian control file. This parser handles control files -- that end without a newline as well as ones that have several blank -- lines at the end. It is very liberal and does not attempt validate -- the fields in any way. All trailing, leading, and folded whitespace -- is preserved in the field values. See 'stripWS'. pControl :: ControlParser Control pControl = do many $ char '\n' sepEndBy pParagraph pBlanks >>= return . Control pParagraph :: ControlParser Paragraph pParagraph = many1 (pComment <|> pField) >>= return . Paragraph -- |We are liberal in that we allow *any* field to have folded white -- space, even though the specific restricts that to a few fields. pField :: ControlParser Field pField = do c1 <- noneOf "#\n" fieldName <- many1 $ noneOf ":\n" char ':' fieldValue <- many fcharfws (char '\n' >> return ()) <|> eof return $ Field (T.cons c1 (T.pack fieldName), T.pack fieldValue) pComment :: ControlParser Field pComment = do char '#' text <- many (satisfy (not . ((==) '\n'))) char '\n' return $ Comment (T.pack ("#" <> text <> "\n")) fcharfws :: ControlParser Char fcharfws = fchar <|> (try $ lookAhead (string "\n ") >> char '\n') <|> (try $ lookAhead (string "\n\t") >> char '\n') <|> (try $ lookAhead (string "\n#") >> char '\n') fchar :: ControlParser Char fchar = satisfy (/='\n') _fws :: ControlParser T.Text _fws = try $ do char '\n' ws <- many1 (char ' ') c <- many1 (satisfy (not . ((==) '\n'))) return $ T.cons '\n' (T.pack ws <> T.pack c) -- |We go with the assumption that 'blank lines' mean lines that -- consist of entirely of zero or more whitespace characters. pBlanks :: ControlParser T.Text pBlanks = do s <- many1 (oneOf " \n") return . T.pack $ s -} cabal-debian-4.31/debian-haskell/Debian/Control/Policy.hs0000644000000000000000000002054312565162075021366 0ustar0000000000000000{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts, FlexibleInstances, FunctionalDependencies, MultiParamTypeClasses, RecordWildCards, ScopedTypeVariables, TemplateHaskell #-} {-# OPTIONS_GHC -Wall #-} -- | Access to things that Debian policy says should be in a valid -- control file. The pure functions will not throw ControlFileError -- if they are operating on a DebianControl value returned by -- validateDebianControl. However, they might if they are created -- using unsafeDebianControl. module Debian.Control.Policy ( -- * Validated debian control file type DebianControl(unDebianControl) , validateDebianControl , unsafeDebianControl , parseDebianControlFromFile , parseDebianControl , ControlFileError(..) -- * Class of things that contain one DebianControl value , HasDebianControl(debianControl) -- * Pure functions that operate on validated control files , debianSourceParagraph , debianBinaryParagraphs , debianPackageParagraphs , debianPackageNames , debianSourcePackageName , debianBinaryPackageNames , debianRelations , debianBuildDeps , debianBuildDepsIndep ) where import Control.Exception (Exception, throw) import Control.Monad.Catch (MonadCatch, try) import Data.List (intercalate) import Data.Text (Text) import Data.Typeable (Typeable) import Data.ListLike (toList) import Debian.Control.Common (Control'(..), Paragraph'(..), Field'(..), fieldValue, ControlFunctions(parseControlFromFile, parseControl)) import Debian.Control.Text () import Debian.Loc (__LOC__) import Debian.Pretty (prettyShow) import Debian.Relation (SrcPkgName(..), BinPkgName(..), Relations, parseRelations) import Debian.Relation.Text () import Language.Haskell.TH (Loc(..)) import Prelude hiding (ioError) -- import qualified Debug.ShowPlease as Please import Text.Parsec.Error (ParseError) -- | Opaque (constructor not exported) type to hold a validated Debian -- Control File data DebianControl = DebianControl {unDebianControl :: Control' Text} instance Show DebianControl where show c = "(parseDebianControl \"\" " ++ show (prettyShow (unDebianControl c)) ++ ")" -- | Validate and return a control file in an opaque wrapper. May -- throw a ControlFileError. Currently we only verify that it has a -- Source field in the first paragraph and one or more subsequent -- paragraphs each with a Package field, and no syntax errors in the -- build dependencies (though they may be absent.) validateDebianControl :: MonadCatch m => Control' Text -> m (Either ControlFileError DebianControl) validateDebianControl ctl = try (do _ <- return $ debianPackageNames (DebianControl ctl) _ <- return $ debianBuildDeps (DebianControl ctl) _ <- return $ debianBuildDepsIndep (DebianControl ctl) return ()) >>= return . either Left (\ _ -> Right $ DebianControl ctl) unsafeDebianControl :: Control' Text -> DebianControl unsafeDebianControl = DebianControl parseDebianControl :: MonadCatch m => String -> Text -> m (Either ControlFileError DebianControl) parseDebianControl sourceName s = either (return . Left . ParseControlError [$__LOC__]) validateDebianControl (parseControl sourceName s) parseDebianControlFromFile :: FilePath -> IO (Either ControlFileError DebianControl) parseDebianControlFromFile controlPath = try (parseControlFromFile controlPath) >>= either (return . Left . IOError [$__LOC__]) (either (return . Left . ParseControlError [$__LOC__]) validateDebianControl) -- | Class of things that contain a validated Debian control file. class HasDebianControl a where debianControl :: a -> DebianControl instance HasDebianControl DebianControl where debianControl = id class HasControl a where control :: a -> Control' Text instance HasControl (Control' Text) where control = id instance HasControl DebianControl where control = unDebianControl -- | Errors that control files might throw, with source file name and -- line number generated by template haskell. data ControlFileError = NoParagraphs {locs :: [Loc]} | NoBinaryParagraphs {locs :: [Loc]} | MissingField {locs :: [Loc], field :: String} | ParseRelationsError {locs :: [Loc], parseError :: ParseError} | ParseControlError {locs :: [Loc], parseError :: ParseError} | IOError {locs :: [Loc], ioError :: IOError} deriving Typeable instance Show ControlFileError where show (NoParagraphs {..}) = intercalate ", " (map showLoc locs) ++ ": NoParagraphs" show (NoBinaryParagraphs {..}) = intercalate ", " (map showLoc locs) ++ ": NoBinaryParagraphs" show (MissingField {..}) = intercalate ", " (map showLoc locs) ++ ": MissingField " ++ show field show (ParseRelationsError {..}) = intercalate ", " (map showLoc locs) ++ ": ParseRelationsError " ++ show parseError show (ParseControlError {..}) = intercalate ", " (map showLoc locs) ++ ": ParseControlError " ++ show parseError show (IOError {..}) = intercalate ", " (map showLoc locs) ++ ": IOError " ++ show ioError showLoc :: Loc -> String showLoc x = show (loc_filename x) ++ "(line " ++ show (fst (loc_start x)) ++ ", column " ++ show (snd (loc_start x)) ++ ")" -- instance Please.Show ControlFileError where -- show (IOError e) = "(IOError " ++ Please.show e ++ ")" -- show (ParseRelationsError e) = "(ParseRelationsError " ++ Please.show e ++ ")" -- show (ParseControlError e) = "(ParseControlError " ++ Please.show e ++ ")" -- show x = show x instance Exception ControlFileError instance Eq ControlFileError where _ == _ = False debianPackageParagraphs :: HasDebianControl a => a -> (Paragraph' Text, [Paragraph' Text]) debianPackageParagraphs ctl = case removeCommentParagraphs ctl of DebianControl (Control [_]) -> throw $ NoBinaryParagraphs [$__LOC__] DebianControl (Control []) -> throw $ NoParagraphs [$__LOC__] DebianControl (Control (sourceParagraph : binParagraphs)) -> (sourceParagraph, binParagraphs) -- | Comment paragraphs are rare, but they happen. removeCommentParagraphs :: HasDebianControl a => a -> DebianControl removeCommentParagraphs c = DebianControl (Control (filter (not . isCommentParagraph) (unControl (unDebianControl (debianControl c))))) where isCommentParagraph (Paragraph fields) = all isCommentField fields isCommentField (Comment _) = True isCommentField _ = False debianSourceParagraph :: HasDebianControl a => a -> Paragraph' Text debianSourceParagraph = fst . debianPackageParagraphs debianBinaryParagraphs :: HasDebianControl a => a -> [Paragraph' Text] debianBinaryParagraphs = snd . debianPackageParagraphs debianPackageNames :: HasDebianControl a => a -> (SrcPkgName, [BinPkgName]) debianPackageNames c = let (srcParagraph, binParagraphs) = debianPackageParagraphs c in (mapFieldValue (SrcPkgName . toList) "Source" srcParagraph, map (mapFieldValue (BinPkgName . toList) "Package") binParagraphs) debianSourcePackageName :: HasDebianControl a => a -> SrcPkgName debianSourcePackageName = fst . debianPackageNames debianBinaryPackageNames :: HasDebianControl a => a -> [BinPkgName] debianBinaryPackageNames = snd . debianPackageNames debianBuildDepsIndep :: HasDebianControl a => a -> Maybe Relations debianBuildDepsIndep ctl = either throw id $ debianRelations "Build-Depends-Indep" (debianControl ctl) debianBuildDeps :: HasDebianControl a => a -> Maybe Relations debianBuildDeps ctl = either throw id $ debianRelations "Build-Depends" (debianControl ctl) -- | Version of fieldValue that may throw a ControlFileError. We only -- use this internally on fields that we already validated. fieldValue' :: ControlFunctions text => String -> Paragraph' text -> text fieldValue' fieldName paragraph = maybe (throw $ MissingField [$__LOC__] fieldName) id $ fieldValue fieldName paragraph -- | This could access fields we haven't validated, so -- it can return an error. Additionally, the field might -- be absent, in which case it returns Nothing. debianRelations :: HasDebianControl a => String -> a -> Either ControlFileError (Maybe Relations) debianRelations fieldName ctl = maybe (Right Nothing) (either (Left . ParseRelationsError [$__LOC__]) (Right . Just) . parseRelations) $ fieldValue fieldName (debianSourceParagraph ctl) -- | Apply a function to the text from a named field in a control file paragraph. mapFieldValue :: (Text -> a) -> String -> Paragraph' Text -> a mapFieldValue f fieldName paragraph = f $ fieldValue' fieldName paragraph cabal-debian-4.31/debian-haskell/Debian/Control/ByteString.hs0000644000000000000000000002023412565162075022216 0ustar0000000000000000{-# LANGUAGE CPP, FlexibleContexts, MultiParamTypeClasses, PackageImports, ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-orphans #-} module Debian.Control.ByteString ( Control'(..) , Paragraph'(..) , Field'(..) , Control , Paragraph , Field , ControlFunctions(..) -- * Helper Functions , mergeControls , fieldValue , removeField , prependFields , appendFields , renameField , modifyField , raiseFields ) where -- Standard GHC modules #if !MIN_VERSION_base(4,8,0) import Control.Applicative (Applicative(..)) #endif import Control.Applicative (Alternative(..)) import qualified Control.Exception as E import "mtl" Control.Monad.State import Data.Char(toLower, isSpace, chr, ord) import Data.Word (Word8) import Data.List import qualified Data.ListLike as LL import qualified Data.ListLike.String as LL import Text.ParserCombinators.Parsec.Error import Text.ParserCombinators.Parsec.Pos -- Third Party Modules import qualified Data.ByteString.Char8 as C import Debian.Control.Common hiding (protectFieldText') -- Local Modules -- import ByteStreamParser -- * Types {- newtype Control = Control [Paragraph] newtype Paragraph = Paragraph [Field] newtype Field = Field (C.ByteString, C.ByteString) -} type Control = Control' C.ByteString type Paragraph = Paragraph' C.ByteString type Field = Field' C.ByteString -- * Control Parser type ControlParser a = Parser C.ByteString a pKey :: ControlParser C.ByteString pKey = notEmpty $ pTakeWhile (\c -> (c /= ':') && (c /= '\n')) pValue :: ControlParser C.ByteString pValue = Parser $ \bs -> let newlines = C.elemIndices '\n' bs rest = dropWhile continuedAfter newlines ++ [C.length bs] continuedAfter i = bs `safeIndex` (i+1) `elem` map Just " \t#" (text, bs') = C.splitAt (head rest) bs in Ok (text, bs') pField :: ControlParser Field pField = do k <- pKey _ <- pChar ':' v <- pValue -- pChar '\n' (pChar '\n' >> return ()) <|> pEOF return (Field (k,v)) pComment :: ControlParser Field pComment = Parser $ \bs -> let newlines = C.elemIndices '\n' bs linestarts = 0 : map (+1) newlines rest = dropWhile commentAt linestarts ++ [C.length bs] commentAt i = bs `safeIndex` i == Just '#' (text, bs') = C.splitAt (head rest) bs in if C.null text then Empty else Ok (Comment text, bs') pParagraph :: ControlParser Paragraph pParagraph = do f <- pMany1 (pComment <|> pField) pSkipMany (pChar '\n') return (Paragraph f) pControl :: ControlParser Control pControl = do pSkipMany (pChar '\n') c <- pMany pParagraph return (Control c) -- parseControlFromFile :: FilePath -> IO (Either String Control) instance ControlFunctions C.ByteString where parseControlFromFile fp = do c <- C.readFile fp case parse pControl c of Nothing -> return (Left (newErrorMessage (Message ("Failed to parse " ++ fp)) (newPos fp 0 0))) (Just (cntl,_)) -> return (Right cntl) parseControlFromHandle sourceName handle = E.try (C.hGetContents handle) >>= either (\ (e :: E.SomeException) -> error ("parseControlFromHandle ByteString: Failure parsing " ++ sourceName ++ ": " ++ show e)) (return . parseControl sourceName) parseControl sourceName c = do case parse pControl c of Nothing -> Left (newErrorMessage (Message ("Failed to parse " ++ sourceName)) (newPos sourceName 0 0)) Just (cntl,_) -> Right cntl lookupP fieldName (Paragraph fields) = let pFieldName = C.pack (map toLower fieldName) in find (\ (Field (fieldName',_)) -> C.map toLower fieldName' == pFieldName) fields -- NOTE: probably inefficient stripWS = C.reverse . strip . C.reverse . strip where strip = C.dropWhile (flip elem " \t") protectFieldText = protectFieldText' asString = C.unpack protectFieldText' :: (LL.StringLike a, LL.ListLike a Word8) => ControlFunctions a => a -> a protectFieldText' s = case LL.lines s of [] -> LL.empty (l : ls) -> dropWhileEnd (isSpace . chr . fromIntegral) $ LL.unlines $ l : map protect ls where dropWhileEnd :: (LL.StringLike a, LL.ListLike a Word8) => (Word8 -> Bool) -> a -> a dropWhileEnd func = LL.reverse . LL.dropWhile func . LL.reverse -- foldr (\x xs -> if func x && LL.null xs then LL.empty else LL.cons x xs) empty protect :: (LL.StringLike a, LL.ListLike a Word8) => a -> a protect l = maybe LL.empty (\ c -> if isHorizSpace c then l else LL.cons (ord' ' ' :: Word8) l) (LL.find (const True :: Word8 -> Bool) l) -- isSpace' = isSpace . chr' isHorizSpace c = elem c (map ord' " \t") ord' = fromIntegral . ord -- chr' = chr . fromIntegral {- main = do [fp] <- getArgs C.readFile fp >>= \c -> maybe (putStrLn "failed.") (print . length . fst) (parse pControl c) -} -- * Helper Functions safeIndex :: C.ByteString -> Int -> Maybe Char bs `safeIndex` i = if i < C.length bs then Just (bs `C.index` i) else Nothing -- * Parser data Result a = Ok a | Fail | Empty deriving Show -- m2r :: Maybe a -> Result a -- m2r (Just a) = Ok a -- m2r Nothing = Empty r2m :: Result a -> Maybe a r2m (Ok a) = Just a r2m _ = Nothing newtype Parser state a = Parser { unParser :: (state -> Result (a, state)) } instance Functor (Parser state) where fmap f m = Parser $ \ state -> let r = (unParser m) state in case r of Ok (a,state') -> Ok (f a,state') Empty -> Empty Fail -> Fail instance Applicative (Parser state) where pure = return (<*>) = ap instance Alternative (Parser state) where empty = Parser $ \state -> (unParser mzero) state (<|>) = mplus instance Monad (Parser state) where return a = Parser (\s -> Ok (a,s)) m >>= f = Parser $ \state -> let r = (unParser m) state in case r of Ok (a,state') -> case unParser (f a) $ state' of Empty -> Fail o -> o Empty -> Empty Fail -> Fail instance MonadPlus (Parser state) where mzero = Parser (const Empty) mplus (Parser p1) (Parser p2) = Parser (\s -> case p1 s of Empty -> p2 s o -> o ) -- Parser (\s -> maybe (p2 s) (Just) (p1 s)) _pSucceed :: a -> Parser state a _pSucceed = return _pFail :: Parser state a _pFail = Parser (const Empty) satisfy :: (Char -> Bool) -> Parser C.ByteString Char satisfy f = Parser $ \bs -> if C.null bs then Empty else let (s,ss) = (C.head bs, C.tail bs) in if (f s) then Ok (s,ss) else Empty pChar :: Char -> Parser C.ByteString Char pChar c = satisfy ((==) c) _try :: Parser state a -> Parser state a _try (Parser p) = Parser $ \bs -> case (p bs) of Fail -> Empty o -> o pEOF :: Parser C.ByteString () pEOF = Parser $ \bs -> if C.null bs then Ok ((),bs) else Empty pTakeWhile :: (Char -> Bool) -> Parser C.ByteString C.ByteString pTakeWhile f = Parser $ \bs -> Ok (C.span f bs) _pSkipWhile :: (Char -> Bool) -> Parser C.ByteString () _pSkipWhile p = Parser $ \bs -> Ok ((), C.dropWhile p bs) pMany :: Parser st a -> Parser st [a] pMany p = scan id where scan f = do x <- p scan (\tail -> f (x:tail)) <|> return (f []) notEmpty :: Parser st C.ByteString -> Parser st C.ByteString notEmpty (Parser p) = Parser $ \s -> case p s of o@(Ok (a, _s)) -> if C.null a then Empty else o x -> x pMany1 :: Parser st a -> Parser st [a] pMany1 p = do x <- p xs <- pMany p return (x:xs) pSkipMany :: Parser st a -> Parser st () pSkipMany p = scan where scan = (p >> scan) <|> return () _pSkipMany1 :: Parser st a -> Parser st () _pSkipMany1 p = p >> pSkipMany p parse :: Parser state a -> state -> Maybe (a, state) parse p s = r2m ((unParser p) s) cabal-debian-4.31/debian-haskell/Debian/Control/String.hs0000644000000000000000000000776212565162075021405 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, ScopedTypeVariables, TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-name-shadowing -fno-warn-unused-do-bind #-} module Debian.Control.String ( -- * Types Control'(..) , Paragraph'(..) , Field'(..) , Control , Paragraph , Field , ControlParser , ControlFunctions(..) -- * Control File Parser , pControl -- * Helper Functions , mergeControls , fieldValue , removeField , prependFields , appendFields , renameField , modifyField , raiseFields ) where import qualified Control.Exception as E import Data.Char (toLower) import Data.List (find) import Debian.Control.Common (ControlFunctions(parseControlFromFile, parseControlFromHandle, parseControl, lookupP, stripWS, protectFieldText, asString), Control'(Control), Paragraph'(Paragraph), Field'(Field, Comment), mergeControls, fieldValue, removeField, prependFields, appendFields, renameField, modifyField, raiseFields, protectFieldText') import System.IO (hGetContents) import Text.ParserCombinators.Parsec (CharParser, parse, parseFromFile, sepEndBy, satisfy, oneOf, string, lookAhead, try, many, many1, (<|>), noneOf, char, eof) type Field = Field' String type Control = Control' String type Paragraph = Paragraph' String -- * ControlFunctions instance ControlFunctions String where parseControlFromFile filepath = parseFromFile pControl filepath parseControlFromHandle sourceName handle = E.try (hGetContents handle) >>= either (\ (e :: E.SomeException) -> error ("parseControlFromHandle String: Failure parsing " ++ sourceName ++ ": " ++ show e)) (return . parseControl sourceName) parseControl sourceName c = parse pControl sourceName c lookupP fieldName (Paragraph paragraph) = find (hasFieldName (map toLower fieldName)) paragraph where hasFieldName name (Field (fieldName',_)) = name == map toLower fieldName' hasFieldName _ _ = False stripWS = reverse . strip . reverse . strip where strip = dropWhile (flip elem " \t") protectFieldText = protectFieldText' asString = id -- * Control File Parser type ControlParser a = CharParser () a -- |A parser for debian control file. This parser handles control files -- that end without a newline as well as ones that have several blank -- lines at the end. It is very liberal and does not attempt validate -- the fields in any way. All trailing, leading, and folded whitespace -- is preserved in the field values. See 'stripWS'. pControl :: ControlParser Control pControl = do many $ char '\n' sepEndBy pParagraph pBlanks >>= return . Control pParagraph :: ControlParser Paragraph pParagraph = many1 (pComment <|> pField) >>= return . Paragraph -- |We are liberal in that we allow *any* field to have folded white -- space, even though the specific restricts that to a few fields. pField :: ControlParser Field pField = do c1 <- noneOf "#\n" fieldName <- many1 $ noneOf ":\n" char ':' fieldValue <- many fcharfws (char '\n' >> return ()) <|> eof return $ Field (c1 : fieldName, fieldValue) pComment :: ControlParser Field pComment = do char '#' text <- many (satisfy (not . ((==) '\n'))) char '\n' return $ Comment ("#" ++ text ++ "\n") fcharfws :: ControlParser Char fcharfws = fchar <|> (try $ lookAhead (string "\n ") >> char '\n') <|> (try $ lookAhead (string "\n\t") >> char '\n') <|> (try $ lookAhead (string "\n#") >> char '\n') fchar :: ControlParser Char fchar = satisfy (/='\n') _fws :: ControlParser String _fws = try $ do char '\n' ws <- many1 (char ' ') c <- many1 (satisfy (not . ((==) '\n'))) return $ '\n' : (ws ++ c) -- |We go with the assumption that 'blank lines' mean lines that -- consist of entirely of zero or more whitespace characters. pBlanks :: ControlParser String pBlanks = many1 (oneOf " \n") cabal-debian-4.31/test-data/0000755000000000000000000000000012565162075014010 5ustar0000000000000000cabal-debian-4.31/test-data/clckwrks-dot-com/0000755000000000000000000000000012565162075017173 5ustar0000000000000000cabal-debian-4.31/test-data/clckwrks-dot-com/input/0000755000000000000000000000000012565162075020332 5ustar0000000000000000cabal-debian-4.31/test-data/clckwrks-dot-com/input/clckwrks-dot-com.cabal0000644000000000000000000000356412565162075024511 0ustar0000000000000000name: clckwrks-dot-com version: 0.2.4 synopsis: clckwrks.com homepage: http://www.clckwrks.com/ license: BSD3 license-file: LICENSE copyright: Copyright (c) 2012, Jeremy Shaw author: Jeremy Shaw maintainer: Jeremy Shaw category: Clckwrks build-type: Simple cabal-version: >=1.8 synopsis: clckwrks.com source-repository head type: darcs subdir: clckwrks-dot-com location: http://hub.darcs.net/stepcut/clckwrks Flag backups Description: enable the backups executable (currently disabled by default do to wacky dependencies not on hackage) Default: False Executable clckwrks-dot-com-server main-is: Main.hs ghc-options: -threaded -O2 -rtsopts -with-rtsopts=-I0 build-depends: base > 4 && <5, clckwrks >= 0.13 && < 0.15, clckwrks-theme-clckwrks == 0.2.*, clckwrks-plugin-bugs == 0.3.*, clckwrks-plugin-media == 0.3.*, containers == 0.4.*, happstack-server >= 7.0 && < 7.2, hsp == 0.7.*, mtl >= 2.0 && < 2.2, text == 0.11.*, web-plugins == 0.1.* Executable clckwrks-dot-com-backups Main-Is: Backups.hs if flag(backups) Buildable: True GHC-Options: -threaded -Wall -Wwarn -O2 -fno-warn-name-shadowing -fno-warn-missing-signatures -fwarn-tabs -fno-warn-unused-binds -fno-warn-orphans -fwarn-unused-imports -fno-spec-constr Build-depends: archive >= 1.2.9, base, Extra else Buildable: False cabal-debian-4.31/test-data/clckwrks-dot-com/input/LICENSE0000644000000000000000000000276012565162075021344 0ustar0000000000000000Copyright (c) 2012, Jeremy Shaw All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Jeremy Shaw nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. cabal-debian-4.31/test-data/clckwrks-dot-com/input/debian/0000755000000000000000000000000012565162075021554 5ustar0000000000000000cabal-debian-4.31/test-data/clckwrks-dot-com/input/debian/Debianize.hs0000644000000000000000000001115312565162075024003 0ustar0000000000000000import Data.List (isPrefixOf) import Debian.Relation (BinPkgName(..)) import Debian.Cabal.Config (Flags(..), defaultConfig, defaultFlags, Executable(..), Server(..), Site(..), tightDependencyFixup) import Debian.Cabal.Types (DebAtom(..)) import Debian.Cabal.Debianize import Debian.Cabal.Server (databaseDirectory) import Distribution.Simple import qualified Paths_clckwrks as Clckwrks main :: IO () main = config >>= deb >>= uncurry (doDebianization config) deb :: Config -> IO (Debianization, Debianization) deb config = debianizationWithIO config config :: IO Config config = do jstreePath <- Clckwrks.getDataFileName "jstree" json2Path <- Clckwrks.getDataFileName "json2" (defaultConfig defaultFlags) { missingDependencies = ["libghc-clckwrks-theme-clckwrks-doc"] , executablePackages = map (theSite jstreePath json2Path "clckwrks-dot-com-server") serverNames ++ [backups] , haddock = True , revision = "" , modifyAtoms = \ atoms -> map fixRulesHead atoms ++ concatMap (\ package -> tightDependencyFixup package -- For each pair (A, B) make sure that this package requires the -- same exact version of package B as the version of A currently -- installed during the build. [("libghc-clckwrks-theme-clckwrks-dev", "haskell-clckwrks-theme-clckwrks-utils"), ("libghc-clckwrks-plugin-media-dev", "haskell-clckwrks-plugin-media-utils"), ("libghc-clckwrks-plugin-bugs-dev", "haskell-clckwrks-plugin-bugs-utils"), ("libghc-clckwrks-dev", "haskell-clckwrks-utils")]) serverNames } where serverNames = map BinPkgName ["clckwrks-dot-com-production"] -- , "clckwrks-dot-com-staging", "clckwrks-dot-com-development"] -- Insert a line just above the debhelper.mk include fixRulesHead (DebRulesHead s) = DebRulesHead $ unlines $ concat $ map (\ line -> if line == "include /usr/share/cdbs/1/rules/debhelper.mk" then ["DEB_SETUP_GHC_CONFIGURE_ARGS = -fbackups", "", line] else [line]) (lines s) fixRulesHead x = x theSite :: FilePath -> FilePath -> String -> BinPkgName -> Executable theSite jstreePath json2Path name (BinPkgName deb) = let this = Executable { debName = deb , execName = name , destName = deb , sourceDir = Nothing , destDir = Nothing , execServer = Just (Server { hostname = case deb of "clckwrks-dot-com-production" -> hostname _ -> hostname , port = portNum , site = case deb of "clckwrks-dot-com-production" -> Just (Site { domain = hostname, serverAdmin = "logic@seereason.com" }) _ -> Nothing , headerMessage = "Generated by clckwrks-dot-com/Setup.hs" , retry = "60" , flags = [ "--http-port", show portNum , "--hide-port" , "--hostname", hostname , "--top", databaseDirectory this , "--enable-analytics" , "--jquery-path", "/usr/share/javascript/jquery/" , "--jqueryui-path", "/usr/share/javascript/jquery-ui/" , "--jstree-path", jstreePath , "--json2-path",json2Path ] }) } in this where hostname = "clckwrks.com" portNum = case deb of "clckwrks-dot-com-production" -> 9029 "clckwrks-dot-com-staging" -> 9038 "clckwrks-dot-com-development" -> 9039 _ -> error $ "Unexpected package name: " ++ name backups = Executable { execName = "clckwrks-dot-com-backups" , destName = "clckwrks-dot-com-backups" , debName = "clckwrks-dot-com-backups" , sourceDir = Nothing , destDir = Just "/etc/cron.hourly" , execServer = Nothing } cabal-debian-4.31/test-data/clckwrks-dot-com/input/debian/changelog0000644000000000000000000000601712565162075023432 0ustar0000000000000000haskell-clckwrks-dot-com (0.2.4) unstable; urgency=low * Bumped to allow clckwrks 0.14 -- Jeremy Shaw Wed, 26 Dec 2012 11:56:20 -0600 haskell-clckwrks-dot-com (0.2.3) unstable; urgency=low * Added -rtsopts flag because the debian packaging requires it -- Jeremy Shaw Thu, 20 Dec 2012 15:51:07 -0600 haskell-clckwrks-dot-com (0.2.2) unstable; urgency=low * Added -with-rtsopts=-I0 flag to ghc-options -- Jeremy Shaw Wed, 19 Dec 2012 15:20:12 -0600 haskell-clckwrks-dot-com (0.2.1) unstable; urgency=low * include blogHandler hack -- Jeremy Shaw Tue, 11 Dec 2012 00:06:09 -0600 haskell-clckwrks-dot-com (0.2.0) unstable; urgency=low * Updated to clckwrks 0.13.* * Debianization generated by cabal-debian * Debianization generated by cabal-debian * Debianization generated by cabal-debian * Debianization generated by cabal-debian -- Jeremy Shaw Wed, 28 Nov 2012 15:58:44 -0600 haskell-clckwrks-dot-com (0.1.18) unstable; urgency=low * Allow most recent containers -- Jeremy Shaw Fri, 05 Oct 2012 18:49:33 -0500 haskell-clckwrks-dot-com (0.1.17) unstable; urgency=low * Updated to clckwrks 0.12 * Added waitForTermination -- Jeremy Shaw Wed, 22 Aug 2012 12:08:33 -0500 haskell-clckwrks-dot-com (0.1.16) unstable; urgency=low * Now with support for page slugs -- Jeremy Shaw Fri, 10 Aug 2012 15:13:24 -0500 haskell-clckwrks-dot-com (0.1.15) unstable; urgency=low * updated to latest clcwrks -- Jeremy Shaw Tue, 19 Jun 2012 17:48:37 -0500 haskell-clckwrks-dot-com (0.1.13) unstable; urgency=low * Bumped by accident, but whatever. -- Jeremy Shaw Sat, 09 Jun 2012 17:52:18 -0500 haskell-clckwrks-dot-com (0.1.11) unstable; urgency=low * Who knows -- Jeremy Shaw Tue, 05 Jun 2012 16:39:52 -0500 haskell-clckwrks-dot-com (0.1.6) unstable; urgency=low * Also generate depends on haskell-clckwrks-utils -- Jeremy Shaw Mon, 21 May 2012 18:22:27 -0500 haskell-clckwrks-dot-com (0.1.5) unstable; urgency=low * Fixed debian/rules so that it generates the depends for haskell-clckwrks-theme-clckwrks-utils -- Jeremy Shaw Mon, 21 May 2012 16:31:20 -0500 haskell-clckwrks-dot-com (0.1.4) unstable; urgency=low * Added missing 'cpp-options: -DCABAL' to .cabal * Added missing depends on haskell-clckwrks-theme-clckwrks-utils -- Jeremy Shaw Mon, 21 May 2012 15:07:35 -0500 haskell-clckwrks-dot-com (0.1.3) unstable; urgency=low * Updated command-line processing to match what happstack-debianization expects -- Jeremy Shaw Mon, 21 May 2012 12:39:45 -0500 haskell-clckwrks-dot-com (0.1.2-1~hackage1) unstable; urgency=low * Debianization generated by cabal-debian -- Jeremy Shaw Sun, 20 May 2012 13:50:50 -0500 cabal-debian-4.31/test-data/clckwrks-dot-com/output/0000755000000000000000000000000012565162075020533 5ustar0000000000000000cabal-debian-4.31/test-data/clckwrks-dot-com/output/debian/0000755000000000000000000000000012565162075021755 5ustar0000000000000000cabal-debian-4.31/test-data/clckwrks-dot-com/output/debian/watch0000644000000000000000000000020712565162075023005 0ustar0000000000000000version=3 http://hackage.haskell.org/package/clckwrks-dot-com/distro-monitor .*-([0-9\.]+)\.(?:zip|tgz|tbz|txz|(?:tar\.(?:gz|bz2|xz))) cabal-debian-4.31/test-data/clckwrks-dot-com/output/debian/Debianize.hs0000644000000000000000000001104712565162075024206 0ustar0000000000000000import Data.List (isPrefixOf) import Debian.Relation (BinPkgName(..)) import Distribution.Debian (Flags(..), Config(..), defaultFlags, Executable(..), Server(..), Site(..), tightDependencyFixup) import Distribution.Debian.DebHelper (DebAtom(..)) import Distribution.Debian.Debianize import Distribution.Debian.Server (databaseDirectory) import Distribution.Simple import qualified Paths_clckwrks as Clckwrks main :: IO () main = do jstreePath <- Clckwrks.getDataFileName "jstree" json2Path <- Clckwrks.getDataFileName "json2" Distribution.Debian.Debianize.debianize $ Config { flags = defaultFlags { missingDependencies = ["libghc-clckwrks-theme-clckwrks-doc"] , executablePackages = map (theSite jstreePath json2Path "clckwrks-dot-com-server") serverNames ++ [backups] , haddock = True , revision = "" } , modifyAtoms = \ atoms -> map fixRulesHead atoms ++ concatMap (\ package -> tightDependencyFixup package -- For each pair (A, B) make sure that this package requires the -- same exact version of package B as the version of A currently -- installed during the build. [("libghc-clckwrks-theme-clckwrks-dev", "haskell-clckwrks-theme-clckwrks-utils"), ("libghc-clckwrks-plugin-media-dev", "haskell-clckwrks-plugin-media-utils"), ("libghc-clckwrks-plugin-bugs-dev", "haskell-clckwrks-plugin-bugs-utils"), ("libghc-clckwrks-dev", "haskell-clckwrks-utils")]) serverNames } where serverNames = map BinPkgName ["clckwrks-dot-com-production"] -- , "clckwrks-dot-com-staging", "clckwrks-dot-com-development"] -- Insert a line just above the debhelper.mk include fixRulesHead (DebRulesHead s) = DebRulesHead $ unlines $ concat $ map (\ line -> if line == "include /usr/share/cdbs/1/rules/debhelper.mk" then ["DEB_SETUP_GHC_CONFIGURE_ARGS = -fbackups", "", line] else [line]) (lines s) fixRulesHead x = x theSite :: FilePath -> FilePath -> String -> BinPkgName -> Executable theSite jstreePath json2Path name (BinPkgName deb) = let this = Executable { debName = deb , execName = name , destName = deb , sourceDir = Nothing , destDir = Nothing , execServer = Just (Server { hostname = case deb of "clckwrks-dot-com-production" -> hostname _ -> hostname , port = portNum , site = case deb of "clckwrks-dot-com-production" -> Just (Site { domain = hostname, serverAdmin = "logic@seereason.com" }) _ -> Nothing , headerMessage = "Generated by clckwrks-dot-com/Setup.hs" , retry = "60" , serverFlags = [ "--http-port", show portNum , "--hide-port" , "--hostname", hostname , "--top", databaseDirectory this , "--enable-analytics" , "--jquery-path", "/usr/share/javascript/jquery/" , "--jqueryui-path", "/usr/share/javascript/jquery-ui/" , "--jstree-path", jstreePath , "--json2-path",json2Path ] }) } in this where hostname = "clckwrks.com" portNum = case deb of "clckwrks-dot-com-production" -> 9029 "clckwrks-dot-com-staging" -> 9038 "clckwrks-dot-com-development" -> 9039 _ -> error $ "Unexpected package name: " ++ name backups = Executable { execName = "clckwrks-dot-com-backups" , destName = "clckwrks-dot-com-backups" , debName = "clckwrks-dot-com-backups" , sourceDir = Nothing , destDir = Just "/etc/cron.hourly" , execServer = Nothing } cabal-debian-4.31/test-data/clckwrks-dot-com/output/debian/clckwrks-dot-com-production.install0000644000000000000000000000014012565162075030707 0ustar0000000000000000debian/cabalInstall/6cb4323c6b76525f567919adaf912663/clckwrks.com /etc/apache2/sites-available/ cabal-debian-4.31/test-data/clckwrks-dot-com/output/debian/clckwrks-dot-com-backups.postinst0000644000000000000000000000015412565162075030373 0ustar0000000000000000#!/bin/sh case "$1" in configure) /etc/cron.hourly/clckwrks-dot-com-backups --initialize ;; esac cabal-debian-4.31/test-data/clckwrks-dot-com/output/debian/changelog0000644000000000000000000000601612565162075023632 0ustar0000000000000000haskell-clckwrks-dot-com (0.2.4) unstable; urgency=low * Bumped to allow clckwrks 0.14 -- Jeremy Shaw Wed, 26 Dec 2012 11:56:20 -0600 haskell-clckwrks-dot-com (0.2.3) unstable; urgency=low * Added -rtsopts flag because the debian packaging requires it -- Jeremy Shaw Thu, 20 Dec 2012 15:51:07 -0600 haskell-clckwrks-dot-com (0.2.2) unstable; urgency=low * Added -with-rtsopts=-I0 flag to ghc-options -- Jeremy Shaw Wed, 19 Dec 2012 15:20:12 -0600 haskell-clckwrks-dot-com (0.2.1) unstable; urgency=low * include blogHandler hack -- Jeremy Shaw Tue, 11 Dec 2012 00:06:09 -0600 haskell-clckwrks-dot-com (0.2.0) unstable; urgency=low * Updated to clckwrks 0.13.* * Debianization generated by cabal-debian * Debianization generated by cabal-debian * Debianization generated by cabal-debian * Debianization generated by cabal-debian -- Jeremy Shaw Wed, 28 Nov 2012 15:58:44 -0600 haskell-clckwrks-dot-com (0.1.18) unstable; urgency=low * Allow most recent containers -- Jeremy Shaw Fri, 05 Oct 2012 18:49:33 -0500 haskell-clckwrks-dot-com (0.1.17) unstable; urgency=low * Updated to clckwrks 0.12 * Added waitForTermination -- Jeremy Shaw Wed, 22 Aug 2012 12:08:33 -0500 haskell-clckwrks-dot-com (0.1.16) unstable; urgency=low * Now with support for page slugs -- Jeremy Shaw Fri, 10 Aug 2012 15:13:24 -0500 haskell-clckwrks-dot-com (0.1.15) unstable; urgency=low * updated to latest clcwrks -- Jeremy Shaw Tue, 19 Jun 2012 17:48:37 -0500 haskell-clckwrks-dot-com (0.1.13) unstable; urgency=low * Bumped by accident, but whatever. -- Jeremy Shaw Sat, 09 Jun 2012 17:52:18 -0500 haskell-clckwrks-dot-com (0.1.11) unstable; urgency=low * Who knows -- Jeremy Shaw Tue, 05 Jun 2012 16:39:52 -0500 haskell-clckwrks-dot-com (0.1.6) unstable; urgency=low * Also generate depends on haskell-clckwrks-utils -- Jeremy Shaw Mon, 21 May 2012 18:22:27 -0500 haskell-clckwrks-dot-com (0.1.5) unstable; urgency=low * Fixed debian/rules so that it generates the depends for haskell-clckwrks-theme-clckwrks-utils -- Jeremy Shaw Mon, 21 May 2012 16:31:20 -0500 haskell-clckwrks-dot-com (0.1.4) unstable; urgency=low * Added missing 'cpp-options: -DCABAL' to .cabal * Added missing depends on haskell-clckwrks-theme-clckwrks-utils -- Jeremy Shaw Mon, 21 May 2012 15:07:35 -0500 haskell-clckwrks-dot-com (0.1.3) unstable; urgency=low * Updated command-line processing to match what happstack-debianization expects -- Jeremy Shaw Mon, 21 May 2012 12:39:45 -0500 haskell-clckwrks-dot-com (0.1.2-1~hackage1) unstable; urgency=low * Debianization generated by cabal-debian -- Jeremy Shaw Sun, 20 May 2012 13:50:50 -0500 cabal-debian-4.31/test-data/clckwrks-dot-com/output/debian/clckwrks-dot-com-production.init0000644000000000000000000000230612565162075030212 0ustar0000000000000000#! /bin/sh -e . /lib/lsb/init-functions test -f /etc/default/clckwrks-dot-com-production && . /etc/default/clckwrks-dot-com-production case "$1" in start) test -x /usr/bin/clckwrks-dot-com-production || exit 0 log_begin_msg "Starting clckwrks-dot-com-production..." mkdir -p /srv/clckwrks-dot-com-production export clckwrks_dot_com_datadir=/usr/share/clckwrks_dot_com "start-stop-daemon" "--start" "-b" "--make-pidfile" "-d" "/srv/clckwrks-dot-com-production" "--exec" "/usr/bin/clckwrks-dot-com-production" "--pidfile" "/var/run/clckwrks-dot-com-production" "--" "--http-port" "9029" "--hide-port" "--hostname" "clckwrks.com" "--top" "/srv/clckwrks-dot-com-production" "--enable-analytics" "--jquery-path" "/usr/share/javascript/jquery/" "--jqueryui-path" "/usr/share/javascript/jquery-ui/" "--jstree-path" "/usr/share/clckwrks-0.13.2/jstree" "--json2-path" "/usr/share/clckwrks-0.13.2/json2" log_end_msg $? ;; stop) log_begin_msg "Stopping clckwrks-dot-com-production..." "start-stop-daemon" "--stop" "--oknodo" "--retry=60" "--pidfile" "/var/run/clckwrks-dot-com-production" log_end_msg $? ;; *) log_success_msg "Usage: ${0} {start|stop}" exit 1 esac exit 0 cabal-debian-4.31/test-data/clckwrks-dot-com/output/debian/control0000644000000000000000000000632512565162075023366 0ustar0000000000000000Source: haskell-clckwrks-dot-com Maintainer: Jeremy Shaw Priority: extra Section: haskell Build-Depends: debhelper (>= 9) , haskell-devscripts (>= 0.8) , cdbs , ghc , ghc-prof , libghc-clckwrks-dev (>= 0.13) , libghc-clckwrks-dev (<< 0.15) , libghc-clckwrks-prof (>= 0.13) , libghc-clckwrks-prof (<< 0.15) , libghc-clckwrks-plugin-bugs-dev (>= 0.3) , libghc-clckwrks-plugin-bugs-dev (<< 0.4) , libghc-clckwrks-plugin-bugs-prof (>= 0.3) , libghc-clckwrks-plugin-bugs-prof (<< 0.4) , libghc-clckwrks-plugin-media-dev (>= 0.3) , libghc-clckwrks-plugin-media-dev (<< 0.4) , libghc-clckwrks-plugin-media-prof (>= 0.3) , libghc-clckwrks-plugin-media-prof (<< 0.4) , libghc-clckwrks-theme-clckwrks-dev (>= 0.2) , libghc-clckwrks-theme-clckwrks-dev (<< 0.3) , libghc-clckwrks-theme-clckwrks-prof (>= 0.2) , libghc-clckwrks-theme-clckwrks-prof (<< 0.3) , libghc-happstack-server-dev (>= 7.0) , libghc-happstack-server-dev (<< 7.2) , libghc-happstack-server-prof (>= 7.0) , libghc-happstack-server-prof (<< 7.2) , libghc-hsp-dev (>= 0.7) , libghc-hsp-dev (<< 0.8) , libghc-hsp-prof (>= 0.7) , libghc-hsp-prof (<< 0.8) , libghc-mtl-dev (>= 2.0) , libghc-mtl-dev (<< 2.2) , libghc-mtl-prof (>= 2.0) , libghc-mtl-prof (<< 2.2) , libghc-text-dev (>= 0.11) , libghc-text-dev (<< 0.12) , libghc-text-prof (>= 0.11) , libghc-text-prof (<< 0.12) , libghc-web-plugins-dev (>= 0.1) , libghc-web-plugins-dev (<< 0.2) , libghc-web-plugins-prof (>= 0.1) , libghc-web-plugins-prof (<< 0.2) Build-Depends-Indep: ghc-doc , libghc-clckwrks-doc , libghc-clckwrks-plugin-bugs-doc , libghc-clckwrks-plugin-media-doc , libghc-happstack-server-doc , libghc-hsp-doc , libghc-mtl-doc , libghc-text-doc , libghc-web-plugins-doc Standards-Version: 3.9.6 Homepage: http://www.clckwrks.com/ X-Description: clckwrks.com Package: clckwrks-dot-com-production Architecture: any Section: misc Depends: ${haskell:Depends}, ${misc:Depends} Recommends: ${haskell:Recommends} Suggests: ${haskell:Suggests} Conflicts: ${haskell:Conflicts} Provides: ${haskell:Provides} Description: ${haskell:ShortDescription}${haskell:ShortBlurb} ${haskell:LongDescription} . ${haskell:Blurb} Package: clckwrks-dot-com-backups Architecture: any Section: misc Depends: ${haskell:Depends}, ${misc:Depends}, anacron Recommends: ${haskell:Recommends} Suggests: ${haskell:Suggests} Conflicts: ${haskell:Conflicts} Provides: ${haskell:Provides} Description: ${haskell:ShortDescription}${haskell:ShortBlurb} ${haskell:LongDescription} . ${haskell:Blurb} cabal-debian-4.31/test-data/clckwrks-dot-com/output/debian/rules0000644000000000000000000000447612565162075023045 0ustar0000000000000000#!/usr/bin/make -f DEB_SETUP_GHC_CONFIGURE_ARGS = -fbackups DEB_CABAL_PACKAGE = clckwrks-dot-com DEB_DEFAULT_COMPILER = ghc include /usr/share/cdbs/1/rules/debhelper.mk include /usr/share/cdbs/1/class/hlibrary.mk build/clckwrks-dot-com-production:: build-ghc-stamp build/clckwrks-dot-com-backups:: build-ghc-stamp binary-fixup/clckwrks-dot-com-production:: install -Dps dist-ghc/build/clckwrks-dot-com-server/clckwrks-dot-com-server debian/clckwrks-dot-com-production/usr/bin/clckwrks-dot-com-production binary-fixup/clckwrks-dot-com-production:: echo -n 'haskell:Depends=' >> debian/clckwrks-dot-com-production.substvars dpkg-query -W -f='haskell-clckwrks-theme-clckwrks-utils (=$${Version})' libghc-clckwrks-theme-clckwrks-dev >> debian/clckwrks-dot-com-production.substvars echo -n ', ' >> debian/clckwrks-dot-com-production.substvars dpkg-query -W -f='haskell-clckwrks-plugin-media-utils (=$${Version})' libghc-clckwrks-plugin-media-dev >> debian/clckwrks-dot-com-production.substvars echo -n ', ' >> debian/clckwrks-dot-com-production.substvars dpkg-query -W -f='haskell-clckwrks-plugin-bugs-utils (=$${Version})' libghc-clckwrks-plugin-bugs-dev >> debian/clckwrks-dot-com-production.substvars echo -n ', ' >> debian/clckwrks-dot-com-production.substvars dpkg-query -W -f='haskell-clckwrks-utils (=$${Version})' libghc-clckwrks-dev >> debian/clckwrks-dot-com-production.substvars echo '' >> debian/clckwrks-dot-com-production.substvars echo -n 'haskell:Conflicts=' >> debian/clckwrks-dot-com-production.substvars dpkg-query -W -f='haskell-clckwrks-theme-clckwrks-utils (>>$${Version})' libghc-clckwrks-theme-clckwrks-dev >> debian/clckwrks-dot-com-production.substvars echo -n ', ' >> debian/clckwrks-dot-com-production.substvars dpkg-query -W -f='haskell-clckwrks-plugin-media-utils (>>$${Version})' libghc-clckwrks-plugin-media-dev >> debian/clckwrks-dot-com-production.substvars echo -n ', ' >> debian/clckwrks-dot-com-production.substvars dpkg-query -W -f='haskell-clckwrks-plugin-bugs-utils (>>$${Version})' libghc-clckwrks-plugin-bugs-dev >> debian/clckwrks-dot-com-production.substvars echo -n ', ' >> debian/clckwrks-dot-com-production.substvars dpkg-query -W -f='haskell-clckwrks-utils (>>$${Version})' libghc-clckwrks-dev >> debian/clckwrks-dot-com-production.substvars echo '' >> debian/clckwrks-dot-com-production.substvars cabal-debian-4.31/test-data/clckwrks-dot-com/output/debian/clckwrks-dot-com-production.logrotate0000644000000000000000000000065112565162075031250 0ustar0000000000000000/var/log/apache2/clckwrks-dot-com-production/access.log { copytruncate weekly rotate 5 compress missingok } /var/log/apache2/clckwrks-dot-com-production/error.log { copytruncate weekly rotate 5 compress missingok } /var/log/clckwrks-dot-com-production/access.log { weekly rotate 5 compress missingok } /var/log/clckwrks-dot-com-production/app.log { weekly rotate 5 compress missingok } cabal-debian-4.31/test-data/clckwrks-dot-com/output/debian/clckwrks-dot-com-production.postinst0000644000000000000000000000053512565162075031134 0ustar0000000000000000#!/bin/sh case "$1" in configure) # Apache won't start if this directory doesn't exist mkdir -p /var/log/apache2/clckwrks-dot-com-production # Restart apache so it sees the new file in /etc/apache2/sites-enabled /usr/sbin/a2enmod proxy /usr/sbin/a2enmod proxy_http service apache2 restart ;; esac #DEBHELPER# exit 0 cabal-debian-4.31/test-data/clckwrks-dot-com/output/debian/clckwrks-dot-com-backups.install0000644000000000000000000000012212565162075030151 0ustar0000000000000000dist-ghc/build/clckwrks-dot-com-backups/clckwrks-dot-com-backups /etc/cron.hourly cabal-debian-4.31/test-data/clckwrks-dot-com/output/debian/clckwrks-dot-com-production.links0000644000000000000000000000012212565162075030361 0ustar0000000000000000/etc/apache2/sites-available/clckwrks.com /etc/apache2/sites-enabled/clckwrks.com cabal-debian-4.31/test-data/clckwrks-dot-com/output/debian/compat0000644000000000000000000000000212565162075023153 0ustar00000000000000009 cabal-debian-4.31/test-data/clckwrks-dot-com/output/debian/clckwrks-dot-com-production.dirs0000644000000000000000000000011212565162075030201 0ustar0000000000000000/etc/apache2/sites-available /var/log/apache2/clckwrks-dot-com-production cabal-debian-4.31/test-data/clckwrks-dot-com/output/debian/copyright0000644000000000000000000000365312565162075023717 0ustar0000000000000000Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ Upstream-Name: clckwrks-dot-com Upstream-Contact: Jeremy Shaw Source: https://hackage.haskell.org/package/clckwrks-dot-com Files: * Copyright: Copyright (c) 2012, Jeremy Shaw License: BSD3 Files: debian/* Copyright: held by the contributors mentioned in debian/changelog License: BSD3 License: BSD3 Comment: Copyright (c) 2012, Jeremy Shaw . All rights reserved. . Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: . * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. . * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. . * Neither the name of Jeremy Shaw nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. . THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. cabal-debian-4.31/test-data/clckwrks-dot-com/output/debian/cabalInstall/0000755000000000000000000000000012565162075024346 5ustar0000000000000000test-data/clckwrks-dot-com/output/debian/cabalInstall/6cb4323c6b76525f567919adaf912663/0000755000000000000000000000000012565162075030443 5ustar0000000000000000cabal-debian-4.31test-data/clckwrks-dot-com/output/debian/cabalInstall/6cb4323c6b76525f567919adaf912663/clckwrks.com0000644000000000000000000000156212565162075032772 0ustar0000000000000000cabal-debian-4.31 ServerAdmin logic@seereason.com ServerName www.clckwrks.com ServerAlias clckwrks.com ErrorLog /var/log/apache2/clckwrks-dot-com-production/error.log CustomLog /var/log/apache2/clckwrks-dot-com-production/access.log combined ProxyRequests Off AllowEncodedSlashes NoDecode AddDefaultCharset off Order deny,allow #Allow from .example.com Deny from all #Allow from all AddDefaultCharset off Order deny,allow #Allow from .example.com #Deny from all Allow from all SetEnv proxy-sendcl 1 ProxyPass / http://127.0.0.1:9029/ nocanon ProxyPassReverse / http://127.0.0.1:9029/ cabal-debian-4.31/test-data/clckwrks-dot-com/output/debian/source/0000755000000000000000000000000012565162075023255 5ustar0000000000000000cabal-debian-4.31/test-data/clckwrks-dot-com/output/debian/source/format0000644000000000000000000000001512565162075024464 0ustar00000000000000003.0 (native) cabal-debian-4.31/test-data/creativeprompts/0000755000000000000000000000000012565162075017237 5ustar0000000000000000cabal-debian-4.31/test-data/creativeprompts/input/0000755000000000000000000000000012565162075020376 5ustar0000000000000000cabal-debian-4.31/test-data/creativeprompts/input/creativeprompts.cabal0000644000000000000000000000642512565162075024620 0ustar0000000000000000Name: creativeprompts Version: 1.5.2 License: AllRightsReserved License-File: debian/copyright Copyright: (c) 2010-2011 SeeReason Partners LLC Author: Jeremy Shaw Maintainer: Jeremy Shaw Stability: Experimental Category: Web Synopsis: creativeprompts.com Description: A social site for sharing story ideas. Cabal-version: >= 1.8 Build-type: Custom Data-files: static/theme/comment-bottom.png static/theme/comment-middle.png static/theme/comment-top.png static/theme/creative-prompts-logo.png static/theme/entry-bottom.png static/theme/entry-middle.png static/theme/entry-top.png static/theme/json2.js static/theme/menu-bar-background.png static/theme/menu-gradient.png static/theme/paint-background.jpg static/theme/site.js static/theme/style.css Flag base4 Description: Choose the even newer, even smaller, split-up base package. Executable creativeprompts-server Main-Is: Main.hs GHC-Options: -threaded -Wall -Wwarn -O2 -rtsopts -fno-warn-name-shadowing -fno-warn-missing-signatures -fwarn-tabs -fno-warn-unused-binds -fno-warn-orphans -fwarn-unused-imports -fno-spec-constr Build-depends: acid-state >= 0.6.0, authenticate >= 0.8.0, blaze-html >= 0.5, blaze-markup, bytestring, containers, debian-packaging >= 0.8, -- PBKDF2 >= 0.3.1 && < 0.4, safecopy >= 0.6.0, directory, extensible-exceptions, Extra, filepath, digestive-functors >= 0.2, digestive-functors-happstack >= 0.1, digestive-functors-hsp >= 0.3.1, happstack-authenticate >= 0.6, -- happstack-extra, happstack-hsp == 7.1.*, ixset, -- happstack-facebook, happstack-server == 7.0.*, HJScript, hslogger, hsx >= 0.10.2 && < 0.11, hsp >= 0.7.1 && < 0.8, HTTP, jmacro, json, mtl, network, old-time, old-locale, parsec, process, QuickCheck, random, text >= 0.11, time, unix, Unixutils >= 1.29, Unixutils-shadow, utf8-string, web-routes >= 0.26.2, web-routes-happstack, web-routes-hsp, web-routes-th, xss-sanitize >= 0.3.0.1 if !os(windows) -- Cabal has a bug on windows and cannot find trhsx Build-Tools: trhsx if flag(base4) Build-Depends: base >= 4 && < 5, syb Executable creativeprompts-backups Main-Is: Backups.hs GHC-Options: -threaded -Wall -Wwarn -O2 -rtsopts -fno-warn-name-shadowing -fno-warn-missing-signatures -fwarn-tabs -fno-warn-unused-binds -fno-warn-orphans -fwarn-unused-imports -fno-spec-constr Build-depends: archive >= 1.2.9, base, Extra cabal-debian-4.31/test-data/creativeprompts/input/debian/0000755000000000000000000000000012565162075021620 5ustar0000000000000000cabal-debian-4.31/test-data/creativeprompts/input/debian/changelog0000644000000000000000000001062212565162075023473 0ustar0000000000000000haskell-creativeprompts (1.5.2) unstable; urgency=low * Updated to hsx 0.10 -- Jeremy Shaw Tue, 24 Apr 2012 14:16:12 -0500 haskell-creativeprompts (1.5.1) unstable; urgency=low * Updated to safecopy / acid-state 0.6.0 -- Jeremy Shaw Tue, 15 Nov 2011 21:28:31 -0600 haskell-creativeprompts (1.4.1) unstable; urgency=low * Updated to web-routes-0.26.2 -- Jeremy Shaw Fri, 07 Oct 2011 21:49:47 -0500 haskell-creativeprompts (1.4.0) unstable; urgency=low * Updated to latest happstack-authenticate -- Jeremy Shaw Tue, 27 Sep 2011 19:13:21 -0500 haskell-creativeprompts (1.3.0) unstable; urgency=low * Upgrade to latest ixset * Upgrade to latest xss-sanitize * Remove old happstack-data code -- Jeremy Shaw Mon, 19 Sep 2011 17:15:11 -0500 haskell-creativeprompts (1.2.1) unstable; urgency=low * Update textareas to reflect the swap order of col/row params -- Jeremy Shaw Sun, 21 Aug 2011 14:20:43 -0500 haskell-creativeprompts (1.2.0) unstable; urgency=low * Migrated to acid-state -- Jeremy Shaw Sat, 16 Jul 2011 11:39:15 -0500 haskell-creativeprompts (1.1.6) unstable; urgency=low * Updated to new digestive-functors >= 0.1 and friends -- Jeremy Shaw Tue, 03 May 2011 16:30:46 -0500 haskell-creativeprompts (1.1.5) unstable; urgency=low * Updated theme -- Jeremy Shaw Sat, 16 Apr 2011 17:56:52 -0500 haskell-creativeprompts (1.1.4) unstable; urgency=low * Add -rtsopts to GHC-Options and pass +RTS -IO to the server at startup. -- David Fox Wed, 13 Apr 2011 21:40:26 -0700 haskell-creativeprompts (1.1.3) unstable; urgency=low * Minor update to the copy -- Jeremy Shaw Wed, 13 Apr 2011 16:10:35 -0500 haskell-creativeprompts (1.1.2) unstable; urgency=low * Added a little more copy to the pages -- Jeremy Shaw Mon, 04 Apr 2011 14:17:16 -0500 haskell-creativeprompts (1.1.1) unstable; urgency=low * Added back editProfilePage * Fixed entry top img render issues with ie -- Jeremy Shaw Wed, 30 Mar 2011 23:09:05 -0500 haskell-creativeprompts (1.1.0) unstable; urgency=low * Migration to happstack-authentication -- Jeremy Shaw Mon, 28 Mar 2011 10:35:20 -0500 haskell-creativeprompts (1.0.6) unstable; urgency=low * Updated to authenticate 0.8.0 -- Jeremy Shaw Wed, 23 Feb 2011 10:55:47 -0600 haskell-creativeprompts (1.0.5) unstable; urgency=low * Include author name in prompt * Add build dependency on happstack-hsp * Add ability to edit a prompt after you have submitted it -- Jeremy Shaw Mon, 24 Jan 2011 18:43:07 -0600 haskell-creativeprompts (1.0.4) unstable; urgency=low * Automatically add to Moderator powers as well when becoming an Admin * Fixed two typos related to becoming admin -- Jeremy Shaw Thu, 20 Jan 2011 16:18:08 -0600 haskell-creativeprompts (1.0.3) unstable; urgency=low * Switch admin group from 'admin' to 'seereason' -- Jeremy Shaw Thu, 20 Jan 2011 15:50:50 -0600 haskell-creativeprompts (1.0.2) unstable; urgency=low * Minor theme cleanups -- Jeremy Shaw Thu, 20 Jan 2011 15:46:47 -0600 haskell-creativeprompts (1.0.1) unstable; urgency=low * fix login to use baseURI from webConf -- Jeremy Shaw Thu, 20 Jan 2011 14:01:25 -0600 haskell-creativeprompts (1.0.0) unstable; urgency=low * Fixed build issue * Fixed title for prompt page -- Jeremy Shaw Thu, 20 Jan 2011 13:30:41 -0600 haskell-creativeprompts (0.0.4) unstable; urgency=low * Add a backup package. -- David Fox Mon, 03 Jan 2011 13:27:15 -0800 haskell-creativeprompts (0.0.3) unstable; urgency=low * Add analytics to coming soon page as well -- Jeremy Shaw Mon, 13 Dec 2010 17:30:04 -0600 haskell-creativeprompts (0.0.2) unstable; urgency=low * Added analytics code -- Jeremy Shaw Mon, 13 Dec 2010 16:26:18 -0600 haskell-creativeprompts (0.0.1) unstable; urgency=low * Debianization generated by cabal-debian -- Jeremy Shaw Sun, 05 Dec 2010 10:58:18 -0600 cabal-debian-4.31/test-data/creativeprompts/input/debian/copyright0000644000000000000000000000021612565162075023552 0ustar0000000000000000This package is not part of the Debian GNU/Linux distribution. Copyright: (c) 2010-2011, SeeReason Partners LLC License: All Rights Reserved cabal-debian-4.31/test-data/creativeprompts/output/0000755000000000000000000000000012565162075020577 5ustar0000000000000000cabal-debian-4.31/test-data/creativeprompts/output/debian/0000755000000000000000000000000012565162075022021 5ustar0000000000000000cabal-debian-4.31/test-data/creativeprompts/output/debian/watch0000644000000000000000000000020612565162075023050 0ustar0000000000000000version=3 http://hackage.haskell.org/package/creativeprompts/distro-monitor .*-([0-9\.]+)\.(?:zip|tgz|tbz|txz|(?:tar\.(?:gz|bz2|xz))) cabal-debian-4.31/test-data/creativeprompts/output/debian/creativeprompts-development.logrotate0000644000000000000000000000027412565162075031515 0ustar0000000000000000/var/log/creativeprompts-development/access.log { weekly rotate 5 compress missingok } /var/log/creativeprompts-development/app.log { weekly rotate 5 compress missingok } cabal-debian-4.31/test-data/creativeprompts/output/debian/creativeprompts-production.postinst0000644000000000000000000000053412565162075031243 0ustar0000000000000000#!/bin/sh case "$1" in configure) # Apache won't start if this directory doesn't exist mkdir -p /var/log/apache2/creativeprompts-production # Restart apache so it sees the new file in /etc/apache2/sites-enabled /usr/sbin/a2enmod proxy /usr/sbin/a2enmod proxy_http service apache2 restart ;; esac #DEBHELPER# exit 0 cabal-debian-4.31/test-data/creativeprompts/output/debian/changelog0000644000000000000000000001062112565162075023673 0ustar0000000000000000haskell-creativeprompts (1.5.2) unstable; urgency=low * Updated to hsx 0.10 -- Jeremy Shaw Tue, 24 Apr 2012 14:16:12 -0500 haskell-creativeprompts (1.5.1) unstable; urgency=low * Updated to safecopy / acid-state 0.6.0 -- Jeremy Shaw Tue, 15 Nov 2011 21:28:31 -0600 haskell-creativeprompts (1.4.1) unstable; urgency=low * Updated to web-routes-0.26.2 -- Jeremy Shaw Fri, 07 Oct 2011 21:49:47 -0500 haskell-creativeprompts (1.4.0) unstable; urgency=low * Updated to latest happstack-authenticate -- Jeremy Shaw Tue, 27 Sep 2011 19:13:21 -0500 haskell-creativeprompts (1.3.0) unstable; urgency=low * Upgrade to latest ixset * Upgrade to latest xss-sanitize * Remove old happstack-data code -- Jeremy Shaw Mon, 19 Sep 2011 17:15:11 -0500 haskell-creativeprompts (1.2.1) unstable; urgency=low * Update textareas to reflect the swap order of col/row params -- Jeremy Shaw Sun, 21 Aug 2011 14:20:43 -0500 haskell-creativeprompts (1.2.0) unstable; urgency=low * Migrated to acid-state -- Jeremy Shaw Sat, 16 Jul 2011 11:39:15 -0500 haskell-creativeprompts (1.1.6) unstable; urgency=low * Updated to new digestive-functors >= 0.1 and friends -- Jeremy Shaw Tue, 03 May 2011 16:30:46 -0500 haskell-creativeprompts (1.1.5) unstable; urgency=low * Updated theme -- Jeremy Shaw Sat, 16 Apr 2011 17:56:52 -0500 haskell-creativeprompts (1.1.4) unstable; urgency=low * Add -rtsopts to GHC-Options and pass +RTS -IO to the server at startup. -- David Fox Wed, 13 Apr 2011 21:40:26 -0700 haskell-creativeprompts (1.1.3) unstable; urgency=low * Minor update to the copy -- Jeremy Shaw Wed, 13 Apr 2011 16:10:35 -0500 haskell-creativeprompts (1.1.2) unstable; urgency=low * Added a little more copy to the pages -- Jeremy Shaw Mon, 04 Apr 2011 14:17:16 -0500 haskell-creativeprompts (1.1.1) unstable; urgency=low * Added back editProfilePage * Fixed entry top img render issues with ie -- Jeremy Shaw Wed, 30 Mar 2011 23:09:05 -0500 haskell-creativeprompts (1.1.0) unstable; urgency=low * Migration to happstack-authentication -- Jeremy Shaw Mon, 28 Mar 2011 10:35:20 -0500 haskell-creativeprompts (1.0.6) unstable; urgency=low * Updated to authenticate 0.8.0 -- Jeremy Shaw Wed, 23 Feb 2011 10:55:47 -0600 haskell-creativeprompts (1.0.5) unstable; urgency=low * Include author name in prompt * Add build dependency on happstack-hsp * Add ability to edit a prompt after you have submitted it -- Jeremy Shaw Mon, 24 Jan 2011 18:43:07 -0600 haskell-creativeprompts (1.0.4) unstable; urgency=low * Automatically add to Moderator powers as well when becoming an Admin * Fixed two typos related to becoming admin -- Jeremy Shaw Thu, 20 Jan 2011 16:18:08 -0600 haskell-creativeprompts (1.0.3) unstable; urgency=low * Switch admin group from 'admin' to 'seereason' -- Jeremy Shaw Thu, 20 Jan 2011 15:50:50 -0600 haskell-creativeprompts (1.0.2) unstable; urgency=low * Minor theme cleanups -- Jeremy Shaw Thu, 20 Jan 2011 15:46:47 -0600 haskell-creativeprompts (1.0.1) unstable; urgency=low * fix login to use baseURI from webConf -- Jeremy Shaw Thu, 20 Jan 2011 14:01:25 -0600 haskell-creativeprompts (1.0.0) unstable; urgency=low * Fixed build issue * Fixed title for prompt page -- Jeremy Shaw Thu, 20 Jan 2011 13:30:41 -0600 haskell-creativeprompts (0.0.4) unstable; urgency=low * Add a backup package. -- David Fox Mon, 03 Jan 2011 13:27:15 -0800 haskell-creativeprompts (0.0.3) unstable; urgency=low * Add analytics to coming soon page as well -- Jeremy Shaw Mon, 13 Dec 2010 17:30:04 -0600 haskell-creativeprompts (0.0.2) unstable; urgency=low * Added analytics code -- Jeremy Shaw Mon, 13 Dec 2010 16:26:18 -0600 haskell-creativeprompts (0.0.1) unstable; urgency=low * Debianization generated by cabal-debian -- Jeremy Shaw Sun, 05 Dec 2010 10:58:18 -0600 cabal-debian-4.31/test-data/creativeprompts/output/debian/control0000644000000000000000000001706612565162075023436 0ustar0000000000000000Source: haskell-creativeprompts Maintainer: Jeremy Shaw Priority: extra Section: haskell Build-Depends: debhelper (>= 9) , haskell-devscripts (>= 0.8) , cdbs , ghc , ghc-prof , libghc-extra-dev , libghc-extra-prof , libghc-hjscript-dev , libghc-hjscript-prof , libghc-http-dev , libghc-http-prof , libghc-quickcheck2-dev (>= 2) | libghc-quickcheck1-dev (<< 2) , libghc-quickcheck2-prof (>= 2) | libghc-quickcheck1-prof (<< 2) , libghc-unixutils-dev (>= 1.29) , libghc-unixutils-prof (>= 1.29) , libghc-unixutils-shadow-dev , libghc-unixutils-shadow-prof , libghc-acid-state-dev (>= 0.6.0) , libghc-acid-state-prof (>= 0.6.0) , libghc-archive-dev (>= 1.2.9) , libghc-archive-prof (>= 1.2.9) , libghc-authenticate-dev (>= 0.8.0) , libghc-authenticate-prof (>= 0.8.0) , libghc-blaze-html-dev (>= 0.5) , libghc-blaze-html-prof (>= 0.5) , libghc-blaze-markup-dev , libghc-blaze-markup-prof , libghc-debian-packaging-dev (>= 0.8) , libghc-debian-packaging-prof (>= 0.8) , libghc-digestive-functors-dev (>= 0.2) , libghc-digestive-functors-prof (>= 0.2) , libghc-digestive-functors-happstack-dev (>= 0.1) , libghc-digestive-functors-happstack-prof (>= 0.1) , libghc-digestive-functors-hsp-dev (>= 0.3.1) , libghc-digestive-functors-hsp-prof (>= 0.3.1) , libghc-extensible-exceptions-dev , libghc-extensible-exceptions-prof , libghc-happstack-authenticate-dev (>= 0.6) , libghc-happstack-authenticate-prof (>= 0.6) , libghc-happstack-hsp-dev (>= 7.1) , libghc-happstack-hsp-dev (<< 7.2) , libghc-happstack-hsp-prof (>= 7.1) , libghc-happstack-hsp-prof (<< 7.2) , libghc-happstack-server-dev (>= 7.0) , libghc-happstack-server-dev (<< 7.1) , libghc-happstack-server-prof (>= 7.0) , libghc-happstack-server-prof (<< 7.1) , libghc-hslogger-dev , libghc-hslogger-prof , libghc-hsp-dev (>= 0.7.1) , libghc-hsp-dev (<< 0.8) , libghc-hsp-prof (>= 0.7.1) , libghc-hsp-prof (<< 0.8) , libghc-hsx-dev (>= 0.10.2) , libghc-hsx-dev (<< 0.11) , libghc-hsx-prof (>= 0.10.2) , libghc-hsx-prof (<< 0.11) , libghc-ixset-dev , libghc-ixset-prof , libghc-jmacro-dev , libghc-jmacro-prof , libghc-json-dev , libghc-json-prof , libghc-mtl-dev , libghc-mtl-prof , libghc-network-dev , libghc-network-prof , libghc-parsec3-dev (>= 3) | libghc-parsec2-dev (<< 3) , libghc-parsec3-prof (>= 3) | libghc-parsec2-prof (<< 3) , libghc-random-dev , libghc-random-prof , libghc-safecopy-dev (>= 0.6.0) , libghc-safecopy-prof (>= 0.6.0) , libghc-syb-dev , libghc-syb-prof , libghc-text-dev (>= 0.11) , libghc-text-prof (>= 0.11) , libghc-utf8-string-dev , libghc-utf8-string-prof , libghc-web-routes-dev (>= 0.26.2) , libghc-web-routes-prof (>= 0.26.2) , libghc-web-routes-happstack-dev , libghc-web-routes-happstack-prof , libghc-web-routes-hsp-dev , libghc-web-routes-hsp-prof , libghc-web-routes-th-dev , libghc-web-routes-th-prof , libghc-xss-sanitize-dev (>= 0.3.0.1) , libghc-xss-sanitize-prof (>= 0.3.0.1) , haskell-hsx-utils Build-Depends-Indep: ghc-doc , libghc-extra-doc , libghc-hjscript-doc , libghc-http-doc , libghc-quickcheck2-doc (>= 2) | libghc-quickcheck1-doc (<< 2) , libghc-unixutils-doc , libghc-unixutils-shadow-doc , libghc-acid-state-doc , libghc-archive-doc , libghc-authenticate-doc , libghc-blaze-html-doc , libghc-blaze-markup-doc , libghc-debian-packaging-doc , libghc-digestive-functors-doc , libghc-digestive-functors-happstack-doc , libghc-digestive-functors-hsp-doc , libghc-extensible-exceptions-doc , libghc-happstack-authenticate-doc , libghc-happstack-hsp-doc , libghc-happstack-server-doc , libghc-hslogger-doc , libghc-hsp-doc , libghc-hsx-doc , libghc-ixset-doc , libghc-jmacro-doc , libghc-json-doc , libghc-mtl-doc , libghc-network-doc , libghc-parsec3-doc (>= 3) | libghc-parsec2-doc (<< 3) , libghc-random-doc , libghc-safecopy-doc , libghc-syb-doc , libghc-text-doc , libghc-utf8-string-doc , libghc-web-routes-doc , libghc-web-routes-happstack-doc , libghc-web-routes-hsp-doc , libghc-web-routes-th-doc , libghc-xss-sanitize-doc Standards-Version: 3.8.1 X-Description: creativeprompts.com A social site for sharing story ideas. Package: creativeprompts-data Architecture: all Section: misc Depends: ${haskell:Depends}, ${misc:Depends}, Recommends: ${haskell:Recommends} Suggests: ${haskell:Suggests} Conflicts: ${haskell:Conflicts} Provides: ${haskell:Provides} Description: creativeprompts.com data files Static data files for creativeprompts.com Package: creativeprompts-production Architecture: all Section: misc Depends: ${haskell:Depends}, ${misc:Depends}, markdown, Recommends: ${haskell:Recommends} Suggests: ${haskell:Suggests} Conflicts: ${haskell:Conflicts} Provides: ${haskell:Provides} Description: Configuration for running the creativeprompts.com server Production version of the blog server, runs on port 9021 with HTML validation turned off. Package: creativeprompts-development Architecture: all Section: misc Depends: ${haskell:Depends} ${misc:Depends}, markdown, Recommends: ${haskell:Recommends} Suggests: ${haskell:Suggests} Conflicts: ${haskell:Conflicts} Provides: ${haskell:Provides} Description: Configuration for running the creativeprompts.com server Testing version of the blog server, runs on port 8000 with HTML validation turned on. Package: creativeprompts-backups Architecture: any Section: misc Depends: ${haskell:Depends}, ${misc:Depends}, anacron Recommends: ${haskell:Recommends} Suggests: ${haskell:Suggests} Conflicts: ${haskell:Conflicts} Provides: ${haskell:Provides} Description: backup program for creativeprompts.com Install this somewhere other than creativeprompts.com to run automated backups of the database. cabal-debian-4.31/test-data/creativeprompts/output/debian/creativeprompts-production.links0000644000000000000000000000013712565162075030477 0ustar0000000000000000/etc/apache2/sites-available/creativeprompts.com /etc/apache2/sites-enabled/creativeprompts.comcabal-debian-4.31/test-data/creativeprompts/output/debian/rules0000644000000000000000000000135612565162075023103 0ustar0000000000000000#!/usr/bin/make -f DEB_CABAL_PACKAGE = creativeprompts DEB_DEFAULT_COMPILER = ghc include /usr/share/cdbs/1/rules/debhelper.mk include /usr/share/cdbs/1/class/hlibrary.mk build/creativeprompts-production:: build-ghc-stamp build/creativeprompts-development:: build-ghc-stamp build/creativeprompts-data:: build-ghc-stamp build/creativeprompts-backups:: build-ghc-stamp binary-fixup/creativeprompts-production:: install -Dps dist-ghc/build/creativeprompts-server/creativeprompts-server debian/creativeprompts-production/usr/bin/creativeprompts-production binary-fixup/creativeprompts-development:: install -Dps dist-ghc/build/creativeprompts-server/creativeprompts-server debian/creativeprompts-development/usr/bin/creativeprompts-development cabal-debian-4.31/test-data/creativeprompts/output/debian/creativeprompts-production.logrotate0000644000000000000000000000064512565162075031363 0ustar0000000000000000/var/log/apache2/creativeprompts-production/access.log { copytruncate weekly rotate 5 compress missingok } /var/log/apache2/creativeprompts-production/error.log { copytruncate weekly rotate 5 compress missingok } /var/log/creativeprompts-production/access.log { weekly rotate 5 compress missingok } /var/log/creativeprompts-production/app.log { weekly rotate 5 compress missingok } cabal-debian-4.31/test-data/creativeprompts/output/debian/creativeprompts-data.install0000644000000000000000000000163012565162075027547 0ustar0000000000000000./static/theme/comment-bottom.png usr/share/creativeprompts/static/theme ./static/theme/comment-middle.png usr/share/creativeprompts/static/theme ./static/theme/comment-top.png usr/share/creativeprompts/static/theme ./static/theme/creative-prompts-logo.png usr/share/creativeprompts/static/theme ./static/theme/entry-bottom.png usr/share/creativeprompts/static/theme ./static/theme/entry-middle.png usr/share/creativeprompts/static/theme ./static/theme/entry-top.png usr/share/creativeprompts/static/theme ./static/theme/json2.js usr/share/creativeprompts/static/theme ./static/theme/menu-bar-background.png usr/share/creativeprompts/static/theme ./static/theme/menu-gradient.png usr/share/creativeprompts/static/theme ./static/theme/paint-background.jpg usr/share/creativeprompts/static/theme ./static/theme/site.js usr/share/creativeprompts/static/theme ./static/theme/style.css usr/share/creativeprompts/static/theme cabal-debian-4.31/test-data/creativeprompts/output/debian/creativeprompts-production.init0000644000000000000000000000230012565162075030314 0ustar0000000000000000#! /bin/sh -e . /lib/lsb/init-functions test -f /etc/default/creativeprompts-production && . /etc/default/creativeprompts-production case "$1" in start) test -x /usr/bin/creativeprompts-production || exit 0 log_begin_msg "Starting creativeprompts-production..." mkdir -p /srv/creativeprompts-production export creativeprompts_datadir=/usr/share/creativeprompts "start-stop-daemon" "--start" "-b" "--make-pidfile" "-d" "/srv/creativeprompts-production" "--exec" "/usr/bin/creativeprompts-production" "--pidfile" "/var/run/creativeprompts-production" "--" "--http-port" "9022" "--hide-port" "--hostname" "creativeprompts.com" "--top" "/srv/creativeprompts-production" "--enable-analytics" "--jquery-path" "/usr/share/javascript/jquery/" "--jqueryui-path" "/usr/share/javascript/jquery-ui/" "--jstree-path" "/usr/share/clckwrks-0.13.2/jstree" "--json2-path" "/usr/share/clckwrks-0.13.2/json2" log_end_msg $? ;; stop) log_begin_msg "Stopping creativeprompts-production..." "start-stop-daemon" "--stop" "--oknodo" "--retry=60" "--pidfile" "/var/run/creativeprompts-production" log_end_msg $? ;; *) log_success_msg "Usage: ${0} {start|stop}" exit 1 esac exit 0 cabal-debian-4.31/test-data/creativeprompts/output/debian/creativeprompts-production.dirs0000644000000000000000000000011012565162075030307 0ustar0000000000000000/etc/apache2/sites-available /var/log/apache2/creativeprompts-productioncabal-debian-4.31/test-data/creativeprompts/output/debian/creativeprompts-production.install0000644000000000000000000000014612565162075031025 0ustar0000000000000000debian/cabalInstall/a1cb9e4b5241944a3da44e00220b5c31/creativeprompts.com /etc/apache2/sites-available/cabal-debian-4.31/test-data/creativeprompts/output/debian/creativeprompts-backups.install0000644000000000000000000000011712565162075030265 0ustar0000000000000000dist-ghc/build/creativeprompts-backups/creativeprompts-backups /etc/cron.hourlycabal-debian-4.31/test-data/creativeprompts/output/debian/compat0000644000000000000000000000000212565162075023217 0ustar00000000000000009 cabal-debian-4.31/test-data/creativeprompts/output/debian/creativeprompts-development.init0000644000000000000000000000231312565162075030454 0ustar0000000000000000#! /bin/sh -e . /lib/lsb/init-functions test -f /etc/default/creativeprompts-development && . /etc/default/creativeprompts-development case "$1" in start) test -x /usr/bin/creativeprompts-development || exit 0 log_begin_msg "Starting creativeprompts-development..." mkdir -p /srv/creativeprompts-development export creativeprompts_datadir=/usr/share/creativeprompts "start-stop-daemon" "--start" "-b" "--make-pidfile" "-d" "/srv/creativeprompts-development" "--exec" "/usr/bin/creativeprompts-development" "--pidfile" "/var/run/creativeprompts-development" "--" "--http-port" "9034" "--hide-port" "--hostname" "creativeprompts.com" "--top" "/srv/creativeprompts-development" "--enable-analytics" "--jquery-path" "/usr/share/javascript/jquery/" "--jqueryui-path" "/usr/share/javascript/jquery-ui/" "--jstree-path" "/usr/share/clckwrks-0.13.2/jstree" "--json2-path" "/usr/share/clckwrks-0.13.2/json2" log_end_msg $? ;; stop) log_begin_msg "Stopping creativeprompts-development..." "start-stop-daemon" "--stop" "--oknodo" "--retry=60" "--pidfile" "/var/run/creativeprompts-development" log_end_msg $? ;; *) log_success_msg "Usage: ${0} {start|stop}" exit 1 esac exit 0 cabal-debian-4.31/test-data/creativeprompts/output/debian/creativeprompts-backups.postinst0000644000000000000000000000015312565162075030502 0ustar0000000000000000#!/bin/sh case "$1" in configure) /etc/cron.hourly/creativeprompts-backups --initialize ;; esac cabal-debian-4.31/test-data/creativeprompts/output/debian/copyright0000644000000000000000000000021612565162075023753 0ustar0000000000000000This package is not part of the Debian GNU/Linux distribution. Copyright: (c) 2010-2011, SeeReason Partners LLC License: All Rights Reserved cabal-debian-4.31/test-data/creativeprompts/output/debian/creativeprompts-development.postinst0000644000000000000000000000010612565162075031372 0ustar0000000000000000#!/bin/sh case "$1" in configure) ;; esac #DEBHELPER# exit 0 cabal-debian-4.31/test-data/creativeprompts/output/debian/cabalInstall/0000755000000000000000000000000012565162075024412 5ustar0000000000000000test-data/creativeprompts/output/debian/cabalInstall/a1cb9e4b5241944a3da44e00220b5c31/0000755000000000000000000000000012565162075030572 5ustar0000000000000000cabal-debian-4.31creativeprompts/output/debian/cabalInstall/a1cb9e4b5241944a3da44e00220b5c31/creativeprompts.com0000644000000000000000000000157612565162075034532 0ustar0000000000000000cabal-debian-4.31/test-data ServerAdmin logic@seereason.com ServerName www.creativeprompts.com ServerAlias creativeprompts.com ErrorLog /var/log/apache2/creativeprompts-production/error.log CustomLog /var/log/apache2/creativeprompts-production/access.log combined ProxyRequests Off AllowEncodedSlashes NoDecode AddDefaultCharset off Order deny,allow #Allow from .example.com Deny from all #Allow from all AddDefaultCharset off Order deny,allow #Allow from .example.com #Deny from all Allow from all SetEnv proxy-sendcl 1 ProxyPass / http://127.0.0.1:9022/ nocanon ProxyPassReverse / http://127.0.0.1:9022/ cabal-debian-4.31/test-data/creativeprompts/output/debian/source/0000755000000000000000000000000012565162075023321 5ustar0000000000000000cabal-debian-4.31/test-data/creativeprompts/output/debian/source/format0000644000000000000000000000001512565162075024530 0ustar00000000000000003.0 (native) cabal-debian-4.31/test-data/artvaluereport2/0000755000000000000000000000000012565162075017151 5ustar0000000000000000cabal-debian-4.31/test-data/artvaluereport2/input/0000755000000000000000000000000012565162075020310 5ustar0000000000000000cabal-debian-4.31/test-data/artvaluereport2/input/artvaluereport2.cabal0000644000000000000000000000731212565162075024440 0ustar0000000000000000Name: ArtValueReport Version: 1.9.29 License: AllRightsReserved Copyright: (c) 2008-2011, SeeReason Partners LLC Author: David Fox , Clifford Beshers Maintainer: Clifford Beshers Homepage: http://my.appraisalreportonline.com Synopsis: Haskell modules for fine art appraisal applications Description: Haskell modules for fine art appraisal applications Cabal-version: >= 1.2.3.0 build-type: Custom flag local-artvaluereport-data Description: Build with local copy of the artvaluereport-data library Default: False Manual: True Executable artvaluereport2-server Main-is: Main.hs GHC-options: -threaded -O2 -rtsopts -eventlog -Wall -Wwarn -fno-warn-name-shadowing -fno-warn-type-defaults if flag (local-artvaluereport-data) Hs-Source-Dirs: ., ../artvaluereport-data Build-Depends: RJson, xhtml, html-entities, old-time, pwstore-purehaskell, unordered-containers, aeson, HJavaScript, artvaluereport-data >= 1.66 Build-Depends: binary, cereal GHC-options: -Wwarn else Build-Depends: artvaluereport-data >= 1.66 GHC-options: -Wwarn Build-Depends: happstack-authenticate, happstack-scaffolding (>= 0.23) Build-Depends: acid-state >= 0.6, applicative-extras >= 0.1.5, authenticate, base, blaze-html, blaze-markup, bytestring, containers, data-accessor, debian-packaging >= 0.8, digestive-functors, digestive-functors-happstack, directory, directory-tree, Extra >= 1.35, fb, filepath, groom, happstack, happstack-extra, happstack-hsp, happstack-server, happstack-util, harp, HJScript, hslogger, hsp >= 0.4.4, hsx, html, ixset, jmacro >= 0.6.2, json, language-css, lifted-base, mtl, network >= 2.4, old-locale, old-time, parsec, pretty, process, process-extras >= 0.5, QuickCheck >= 2, random, regex-compat, revision, safe, safecopy >= 0.5.1, syb, syb-with-class, tagged, text, time, transformers, uniplate, unix, Unixutils, utf8-string, web-routes, web-routes-happstack, web-routes-hsp, web-routes-th Extensions: FlexibleContexts, FlexibleInstances, NoImplicitPrelude, OverlappingInstances, ScopedTypeVariables, TemplateHaskell, TypeSynonymInstances, UndecidableInstances Executable artvaluereport2-backups Main-Is: Backups.hs GHC-Options: -threaded -Wall -Wwarn -O2 -fno-warn-name-shadowing -fno-warn-missing-signatures -fwarn-tabs -fno-warn-unused-binds -fno-warn-orphans -fwarn-unused-imports -fno-spec-constr Build-depends: archive >= 1.2.9, base, Extra executable lookatareport Main-Is: Tools/LookAtAReport.hs -- Hs-Source-Dirs: ., ../artvaluereport-data_1 -- GHC-Options: -Wall -optP-include -optPdist/build/autogen/cabal_macros.h GHC-Options: -Wall Build-Depends: binary, cereal, debian, HaTeX, html-entities, pandoc, pureMD5, RJson, xhtml executable appraisalscope Main-Is: Tools/AppraisalScope.hs -- Hs-Source-Dirs: ., ../artvaluereport-data_1 -- GHC-Options: -Wall -optP-include -optPdist/build/autogen/cabal_macros.h GHC-Options: -Wall Build-Depends: binary, cereal, debian, HaTeX, html-entities, pandoc, pureMD5, RJson, xhtml cabal-debian-4.31/test-data/artvaluereport2/input/debian/0000755000000000000000000000000012565162075021532 5ustar0000000000000000cabal-debian-4.31/test-data/artvaluereport2/input/debian/Debianize.hs0000644000000000000000000002162712565162075023770 0ustar0000000000000000{-# LANGUAGE CPP, FlexibleContexts, OverloadedStrings #-} 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 import Debian.Debianize.Finalize (debianize) import Debian.Debianize.Optparse (parseProgramArguments, CommandLineOptions(..)) import Debian.Pretty (ppShow) import Debian.Policy (databaseDirectory, PackageArchitectures(All), StandardsVersion(StandardsVersion)) import Debian.Relation (BinPkgName(BinPkgName), Relation(Rel), SrcPkgName(..), VersionReq(SLT)) import Debian.Version (parseDebianVersion) -- This looks somewhat like a "real" Debianize.hs file except that (1) it -- expects to be run from the cabal-debian source directory and (2) it returns -- the comparison string instead of doing a writeDebianization, and (3) it reads -- and writes the test-data directories instead of ".". Also, you wouldn't want -- to copyFirstLogEntry in real life, this is to make sure old and new match. main :: IO () main = do log <- withCurrentDirectory "test-data/artvaluereport2/input" $ parseProgramArguments >>= \opts -> newCabalInfo (_flags opts) >>= evalCabalT (liftCabal inputChangeLog >> use (debInfo . changelog)) new <- withCurrentDirectory "test-data/artvaluereport2/input" $ parseProgramArguments >>= \opts -> newCabalInfo (_flags opts) >>= execCabalT (debianize (debianDefaults >> customize log {- >> removeFirstLogEntry -})) old <- withCurrentDirectory "test-data/artvaluereport2/output" $ parseProgramArguments >>= \opts -> execDebianT inputDebianization (makeDebInfo (_flags opts)) -- The newest log entry gets modified when the Debianization is -- generated, it won't match so drop it for the comparison. putStr $ concat $ compareDebianization old $ view debInfo new where customize :: Maybe ChangeLog -> CabalT IO () customize log = do (debInfo . revision) .= Nothing (debInfo . sourceFormat) .= 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")) doServer (BinPkgName "artvaluereport2-staging") (theServer (BinPkgName "artvaluereport2-staging")) doWebsite (BinPkgName "artvaluereport2-production") (theSite (BinPkgName "artvaluereport2-production")) 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) .= Just (Text.intercalate "\n" [ "backup program for the appraisalreportonline.com site" , " Install this somewhere other than where the server is running get" , " automated backups of the database." ]) addDep (BinPkgName "artvaluereport2-production") (BinPkgName "apache2") addServerData addServerDeps (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 -- 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 addServerDeps :: CabalT IO () addServerDeps = mapM_ addDeps (map BinPkgName ["artvaluereport2-development", "artvaluereport2-staging", "artvaluereport2-production"]) addDeps p = mapM_ (addDep p) (map BinPkgName ["libjpeg-progs", "libjs-jcrop", "libjs-jquery", "libjs-jquery-ui", "netpbm", "texlive-fonts-extra", "texlive-fonts-recommended", "texlive-latex-extra", "texlive-latex-recommended"]) addDep p dep = (debInfo . binaryDebDescription p . relations . depends) %= (++ [[Rel dep Nothing Nothing]]) addServerData :: CabalT IO () addServerData = mapM_ addData (map BinPkgName ["artvaluereport2-development", "artvaluereport2-staging", "artvaluereport2-production"]) addData p = do (debInfo . atomSet) %= (Set.insert $ InstallData p "theme/ArtValueReport_SunsetSpectrum.ico" "ArtValueReport_SunsetSpectrum.ico") mapM_ (addDataFile p) ["Udon.js", "flexbox.css", "DataTables-1.8.2", "html5sortable", "jGFeed", "searchMag.png", "Clouds.jpg", "tweaks.css", "verticalTabs.css", "blueprint", "jquery.blockUI", "jquery.tinyscrollbar"] addDataFile p path = (debInfo . atomSet) %= (Set.insert $ InstallData p path path) theSite :: BinPkgName -> Site theSite deb = Site { domain = hostname' , serverAdmin = "logic@seereason.com" , server = theServer deb } theServer :: BinPkgName -> Server theServer deb = Server { hostname = case deb of BinPkgName "artvaluereport2-production" -> hostname' _ -> hostname' , port = portNum deb , headerMessage = "Generated by artvaluereport2/Setup.hs" , retry = "60" , serverFlags = ([ "--http-port", show (portNum deb) , "--base-uri", case deb of BinPkgName "artvaluereport2-production" -> "http://" ++ hostname' ++ "/" _ -> "http://seereason.com:" ++ show (portNum deb) ++ "/" , "--top", databaseDirectory deb , "--logs", "/var/log/" ++ ppShow deb , "--log-mode", case deb of BinPkgName "artvaluereport2-production" -> "Production" _ -> "Development" , "--static", "/usr/share/artvaluereport2-data" , "--no-validate" ] ++ (case deb of BinPkgName "artvaluereport2-production" -> [{-"--enable-analytics"-}] _ -> []) {- ++ [ "--jquery-path", "/usr/share/javascript/jquery/" , "--jqueryui-path", "/usr/share/javascript/jquery-ui/" , "--jstree-path", jstreePath , "--json2-path",json2Path ] -}) , installFile = InstallFile { execName = "artvaluereport2-server" , destName = ppShow deb , sourceDir = Nothing , destDir = Nothing } } hostname' = "my.appraisalreportonline.com" portNum :: BinPkgName -> Int portNum (BinPkgName deb) = case deb of "artvaluereport2-production" -> 9027 "artvaluereport2-staging" -> 9031 "artvaluereport2-development" -> 9032 _ -> error $ "Unexpected package name: " ++ deb anyrel :: BinPkgName -> Relation anyrel b = Rel b Nothing Nothing removeFirstLogEntry :: Monad m => CabalT m () removeFirstLogEntry = (debInfo . changelog) %= fmap (\ (ChangeLog (_ : tl)) -> ChangeLog tl) copyFirstLogEntry :: DebInfo -> DebInfo -> DebInfo copyFirstLogEntry deb1 deb2 = over changelog (const (Just (ChangeLog (hd1 : tl2)))) deb2 where ChangeLog (hd1 : _) = fromMaybe (error "Missing debian/changelog") (view changelog deb1) ChangeLog (_ : tl2) = fromMaybe (error "Missing debian/changelog") (view changelog deb2) cabal-debian-4.31/test-data/artvaluereport2/input/debian/changelog0000644000000000000000000001526512565162075023415 0ustar0000000000000000haskell-artvaluereport2 (1.9.29) unstable; urgency=low * Add a package for the appraisalscope executable. -- David Fox Fri, 01 Feb 2013 12:34:49 -0800 haskell-artvaluereport2 (1.9.28) unstable; urgency=low * Fix the formatting of the new creation date column in the report list and pave the way for converting the old EpochMilli into UTC time. -- Clifford Beshers Tue, 29 Jan 2013 18:51:00 -0800 haskell-artvaluereport2 (1.9.27) unstable; urgency=low * Report deletion. Reports now in map with key uuid. -- Clifford Beshers Mon, 28 Jan 2013 00:05:49 -0800 haskell-artvaluereport2 (1.9.26) unstable; urgency=low * Add report copying. -- Clifford Beshers Thu, 17 Jan 2013 22:34:49 -0800 haskell-artvaluereport2 (1.9.25) unstable; urgency=low * Myriad. Bump cabal version from 1.9.18. -- David Fox Mon, 17 Dec 2012 14:41:44 -0800 haskell-artvaluereport2 (1.9.24) unstable; urgency=low * Repair the repair of Dimension values. The repair was being rerun on fixed values because I didn't implement this as a migration. Next step, get past event files with these errors, then remove the fixvalue call. -- Clifford Beshers Sun, 04 Nov 2012 20:33:54 -0800 haskell-artvaluereport2 (1.9.23) unstable; urgency=low * Restrict imageSize to a range, set default. * Repair Dimension menu which had values and labels confused. * Repair events which had the bad Dimension values. -- Clifford Beshers Sat, 03 Nov 2012 18:29:31 -0700 haskell-artvaluereport2 (1.9.22) unstable; urgency=low * unsafePerformIO around logging, error to myerror and MyPrelude to control behind the scene failures. * acid-state updates rewritten to be small. -- Clifford Beshers Thu, 01 Nov 2012 22:25:26 -0700 haskell-artvaluereport2 (1.9.21) unstable; urgency=low * Multiple image upload, client greeting, more Item field revisions. Image captions and print size. -- Clifford Beshers Fri, 26 Oct 2012 09:37:05 -0700 haskell-artvaluereport2 (1.9.20) unstable; urgency=low * Item field revisions. -- Clifford Beshers Fri, 19 Oct 2012 00:42:20 -0700 haskell-artvaluereport2 (1.9.19) unstable; urgency=low * Up the minimum size of the request body. Things were being silently truncated, causing decodeJSON errors. -- Clifford Beshers Sat, 13 Oct 2012 21:44:24 -0700 haskell-artvaluereport2 (1.9.18) unstable; urgency=low * Fix errant widget selector that was causing index out of range when editing item lists. -- Clifford Beshers Thu, 11 Oct 2012 23:40:46 -0700 haskell-artvaluereport2 (1.9.17) unstable; urgency=low * Remove errant undefined in image list reordering. -- Clifford Beshers Thu, 11 Oct 2012 12:00:06 -0700 haskell-artvaluereport2 (1.9.16) unstable; urgency=low * Fix new report, which was returning to the wrong report. Add in the UUID for report ids, as yet unused. -- Clifford Beshers Mon, 01 Oct 2012 18:51:11 -0700 haskell-artvaluereport2 (1.9.15) unstable; urgency=low * Fix some layout issues. Turn off the image croppers until fixed. -- Clifford Beshers Thu, 30 Aug 2012 17:33:25 -0700 haskell-artvaluereport2 (1.9.14) unstable; urgency=low * Small tweaks to the appearance. -- Clifford Beshers Wed, 29 Aug 2012 17:02:15 -0700 haskell-artvaluereport2 (1.9.13) unstable; urgency=low * List editing. Mostly. -- Clifford Beshers Wed, 29 Aug 2012 14:53:55 -0700 haskell-artvaluereport2 (1.9.12) unstable; urgency=low * List editing. Testing and one page (Limiting Conditions.) -- Clifford Beshers Tue, 07 Aug 2012 12:27:04 -0700 haskell-artvaluereport2 (1.9.11) unstable; urgency=low * Open pdf in the same tab by default instead of forcing a new one. * Attach "Property to be Appraised" to reportBriefItems. * Expose ItemsOwner with label Client. -- Clifford Beshers Thu, 19 Jul 2012 11:19:50 -0700 haskell-artvaluereport2 (1.9.10) unstable; urgency=low * Use textAreas in the item editor, resize them based on the data. -- Clifford Beshers Mon, 16 Jul 2012 11:32:14 -0700 haskell-artvaluereport2 (1.9.9) unstable; urgency=low * Fix IntendedUse form. -- Clifford Beshers Mon, 16 Jul 2012 00:08:25 -0700 haskell-artvaluereport2 (1.9.8) unstable; urgency=low * Remove debugging links from home page. * Add missing tab for Certifications -- Clifford Beshers Sun, 15 Jul 2012 12:16:03 -0700 haskell-artvaluereport2 (1.9.7) unstable; urgency=low * Many updates, validating that the PDF is getting closer to what it should be. -- Clifford Beshers Fri, 13 Jul 2012 18:31:05 -0700 haskell-artvaluereport2 (1.9.6) unstable; urgency=low * Item fields restored. They are a list, not a record, which is not handled by Builders.empty, so they needed to be created specially. -- Clifford Beshers Fri, 13 Jul 2012 00:52:00 -0700 haskell-artvaluereport2 (1.9.5) unstable; urgency=low * Image source url sort of working. -- Clifford Beshers Thu, 12 Jul 2012 23:43:46 -0700 haskell-artvaluereport2 (1.9.4) unstable; urgency=low * Image source url start. -- Clifford Beshers Thu, 12 Jul 2012 01:42:52 -0700 haskell-artvaluereport2 (1.9.3) unstable; urgency=low * Merge of big fork. Close to critical mass. -- Clifford Beshers Tue, 10 Jul 2012 21:48:43 -0700 haskell-artvaluereport2 (1.9.2) unstable; urgency=low * Bumping version number to ensure everything is pushed to server, tracking down mysterious new report bug. -- Clifford Beshers Mon, 07 May 2012 16:27:06 -0700 haskell-artvaluereport2 (1.9.1) unstable; urgency=low * Many improvements. -- Clifford Beshers Tue, 01 May 2012 12:14:45 -0700 haskell-artvaluereport2 (1.9.0-1~hackage3) unstable; urgency=low * Add markup for missing image. -- Clifford Beshers Wed, 28 Mar 2012 10:02:45 -0700 haskell-artvaluereport2 (1.9.0-1~hackage2) unstable; urgency=low * Lots of formatting fixes. -- Clifford Beshers Tue, 27 Mar 2012 22:32:41 -0700 haskell-artvaluereport2 (1.9.0-1~hackage1) unstable; urgency=low * Debianization generated by cabal-debian -- Clifford Beshers Wed, 29 Jun 2011 01:01:02 -0700 cabal-debian-4.31/test-data/artvaluereport2/output/0000755000000000000000000000000012565162075020511 5ustar0000000000000000cabal-debian-4.31/test-data/artvaluereport2/output/debian/0000755000000000000000000000000012565162076021734 5ustar0000000000000000cabal-debian-4.31/test-data/artvaluereport2/output/debian/artvaluereport2-staging.postinst0000644000000000000000000000010612565162075030330 0ustar0000000000000000#!/bin/sh case "$1" in configure) ;; esac #DEBHELPER# exit 0 cabal-debian-4.31/test-data/artvaluereport2/output/debian/watch0000644000000000000000000000020512565162075022761 0ustar0000000000000000version=3 http://hackage.haskell.org/package/ArtValueReport/distro-monitor .*-([0-9\.]+)\.(?:zip|tgz|tbz|txz|(?:tar\.(?:gz|bz2|xz))) cabal-debian-4.31/test-data/artvaluereport2/output/debian/artvaluereport2-development.postinst0000644000000000000000000000010612565162075031216 0ustar0000000000000000#!/bin/sh case "$1" in configure) ;; esac #DEBHELPER# exit 0 cabal-debian-4.31/test-data/artvaluereport2/output/debian/artvaluereport2-production.links0000644000000000000000000000016212565162075030321 0ustar0000000000000000/etc/apache2/sites-available/my.appraisalreportonline.com /etc/apache2/sites-enabled/my.appraisalreportonline.com cabal-debian-4.31/test-data/artvaluereport2/output/debian/changelog0000644000000000000000000001526512565162075023616 0ustar0000000000000000haskell-artvaluereport2 (1.9.29) unstable; urgency=low * Add a package for the appraisalscope executable. -- David Fox Fri, 01 Feb 2013 12:34:49 -0800 haskell-artvaluereport2 (1.9.28) unstable; urgency=low * Fix the formatting of the new creation date column in the report list and pave the way for converting the old EpochMilli into UTC time. -- Clifford Beshers Tue, 29 Jan 2013 18:51:00 -0800 haskell-artvaluereport2 (1.9.27) unstable; urgency=low * Report deletion. Reports now in map with key uuid. -- Clifford Beshers Mon, 28 Jan 2013 00:05:49 -0800 haskell-artvaluereport2 (1.9.26) unstable; urgency=low * Add report copying. -- Clifford Beshers Thu, 17 Jan 2013 22:34:49 -0800 haskell-artvaluereport2 (1.9.25) unstable; urgency=low * Myriad. Bump cabal version from 1.9.18. -- David Fox Mon, 17 Dec 2012 14:41:44 -0800 haskell-artvaluereport2 (1.9.24) unstable; urgency=low * Repair the repair of Dimension values. The repair was being rerun on fixed values because I didn't implement this as a migration. Next step, get past event files with these errors, then remove the fixvalue call. -- Clifford Beshers Sun, 04 Nov 2012 20:33:54 -0800 haskell-artvaluereport2 (1.9.23) unstable; urgency=low * Restrict imageSize to a range, set default. * Repair Dimension menu which had values and labels confused. * Repair events which had the bad Dimension values. -- Clifford Beshers Sat, 03 Nov 2012 18:29:31 -0700 haskell-artvaluereport2 (1.9.22) unstable; urgency=low * unsafePerformIO around logging, error to myerror and MyPrelude to control behind the scene failures. * acid-state updates rewritten to be small. -- Clifford Beshers Thu, 01 Nov 2012 22:25:26 -0700 haskell-artvaluereport2 (1.9.21) unstable; urgency=low * Multiple image upload, client greeting, more Item field revisions. Image captions and print size. -- Clifford Beshers Fri, 26 Oct 2012 09:37:05 -0700 haskell-artvaluereport2 (1.9.20) unstable; urgency=low * Item field revisions. -- Clifford Beshers Fri, 19 Oct 2012 00:42:20 -0700 haskell-artvaluereport2 (1.9.19) unstable; urgency=low * Up the minimum size of the request body. Things were being silently truncated, causing decodeJSON errors. -- Clifford Beshers Sat, 13 Oct 2012 21:44:24 -0700 haskell-artvaluereport2 (1.9.18) unstable; urgency=low * Fix errant widget selector that was causing index out of range when editing item lists. -- Clifford Beshers Thu, 11 Oct 2012 23:40:46 -0700 haskell-artvaluereport2 (1.9.17) unstable; urgency=low * Remove errant undefined in image list reordering. -- Clifford Beshers Thu, 11 Oct 2012 12:00:06 -0700 haskell-artvaluereport2 (1.9.16) unstable; urgency=low * Fix new report, which was returning to the wrong report. Add in the UUID for report ids, as yet unused. -- Clifford Beshers Mon, 01 Oct 2012 18:51:11 -0700 haskell-artvaluereport2 (1.9.15) unstable; urgency=low * Fix some layout issues. Turn off the image croppers until fixed. -- Clifford Beshers Thu, 30 Aug 2012 17:33:25 -0700 haskell-artvaluereport2 (1.9.14) unstable; urgency=low * Small tweaks to the appearance. -- Clifford Beshers Wed, 29 Aug 2012 17:02:15 -0700 haskell-artvaluereport2 (1.9.13) unstable; urgency=low * List editing. Mostly. -- Clifford Beshers Wed, 29 Aug 2012 14:53:55 -0700 haskell-artvaluereport2 (1.9.12) unstable; urgency=low * List editing. Testing and one page (Limiting Conditions.) -- Clifford Beshers Tue, 07 Aug 2012 12:27:04 -0700 haskell-artvaluereport2 (1.9.11) unstable; urgency=low * Open pdf in the same tab by default instead of forcing a new one. * Attach "Property to be Appraised" to reportBriefItems. * Expose ItemsOwner with label Client. -- Clifford Beshers Thu, 19 Jul 2012 11:19:50 -0700 haskell-artvaluereport2 (1.9.10) unstable; urgency=low * Use textAreas in the item editor, resize them based on the data. -- Clifford Beshers Mon, 16 Jul 2012 11:32:14 -0700 haskell-artvaluereport2 (1.9.9) unstable; urgency=low * Fix IntendedUse form. -- Clifford Beshers Mon, 16 Jul 2012 00:08:25 -0700 haskell-artvaluereport2 (1.9.8) unstable; urgency=low * Remove debugging links from home page. * Add missing tab for Certifications -- Clifford Beshers Sun, 15 Jul 2012 12:16:03 -0700 haskell-artvaluereport2 (1.9.7) unstable; urgency=low * Many updates, validating that the PDF is getting closer to what it should be. -- Clifford Beshers Fri, 13 Jul 2012 18:31:05 -0700 haskell-artvaluereport2 (1.9.6) unstable; urgency=low * Item fields restored. They are a list, not a record, which is not handled by Builders.empty, so they needed to be created specially. -- Clifford Beshers Fri, 13 Jul 2012 00:52:00 -0700 haskell-artvaluereport2 (1.9.5) unstable; urgency=low * Image source url sort of working. -- Clifford Beshers Thu, 12 Jul 2012 23:43:46 -0700 haskell-artvaluereport2 (1.9.4) unstable; urgency=low * Image source url start. -- Clifford Beshers Thu, 12 Jul 2012 01:42:52 -0700 haskell-artvaluereport2 (1.9.3) unstable; urgency=low * Merge of big fork. Close to critical mass. -- Clifford Beshers Tue, 10 Jul 2012 21:48:43 -0700 haskell-artvaluereport2 (1.9.2) unstable; urgency=low * Bumping version number to ensure everything is pushed to server, tracking down mysterious new report bug. -- Clifford Beshers Mon, 07 May 2012 16:27:06 -0700 haskell-artvaluereport2 (1.9.1) unstable; urgency=low * Many improvements. -- Clifford Beshers Tue, 01 May 2012 12:14:45 -0700 haskell-artvaluereport2 (1.9.0-1~hackage3) unstable; urgency=low * Add markup for missing image. -- Clifford Beshers Wed, 28 Mar 2012 10:02:45 -0700 haskell-artvaluereport2 (1.9.0-1~hackage2) unstable; urgency=low * Lots of formatting fixes. -- Clifford Beshers Tue, 27 Mar 2012 22:32:41 -0700 haskell-artvaluereport2 (1.9.0-1~hackage1) unstable; urgency=low * Debianization generated by cabal-debian -- Clifford Beshers Wed, 29 Jun 2011 01:01:02 -0700 cabal-debian-4.31/test-data/artvaluereport2/output/debian/artvaluereport2-production.init0000644000000000000000000000214712565162075030151 0ustar0000000000000000#! /bin/sh -e . /lib/lsb/init-functions test -f /etc/default/artvaluereport2-production && . /etc/default/artvaluereport2-production case "$1" in start) test -x /usr/bin/artvaluereport2-production || exit 0 log_begin_msg "Starting artvaluereport2-production..." mkdir -p /srv/artvaluereport2-production export ArtValueReport_datadir=/usr/share/ArtValueReport "start-stop-daemon" "--start" "-b" "--make-pidfile" "-d" "/srv/artvaluereport2-production" "--exec" "/usr/bin/artvaluereport2-production" "--pidfile" "/var/run/artvaluereport2-production" "--" "--http-port" "9027" "--base-uri" "http://my.appraisalreportonline.com/" "--top" "/srv/artvaluereport2-production" "--logs" "/var/log/artvaluereport2-production" "--log-mode" "Production" "--static" "/usr/share/artvaluereport2-data" "--no-validate" log_end_msg $? ;; stop) log_begin_msg "Stopping artvaluereport2-production..." "start-stop-daemon" "--stop" "--oknodo" "--retry=60" "--pidfile" "/var/run/artvaluereport2-production" log_end_msg $? ;; *) log_success_msg "Usage: ${0} {start|stop}" exit 1 esac exit 0 cabal-debian-4.31/test-data/artvaluereport2/output/debian/artvaluereport2-production.install0000644000000000000000000000122412565162075030647 0ustar0000000000000000Clouds.jpg usr/share/ArtValueReport/. DataTables-1.8.2 usr/share/ArtValueReport/. Udon.js usr/share/ArtValueReport/. blueprint usr/share/ArtValueReport/. debian/cabalInstall/7e4b5d8641f6fae99e9ae9b2d8893bc7/my.appraisalreportonline.com /etc/apache2/sites-available/ flexbox.css usr/share/ArtValueReport/. html5sortable usr/share/ArtValueReport/. jGFeed usr/share/ArtValueReport/. jquery.blockUI usr/share/ArtValueReport/. jquery.tinyscrollbar usr/share/ArtValueReport/. searchMag.png usr/share/ArtValueReport/. theme/ArtValueReport_SunsetSpectrum.ico usr/share/ArtValueReport/. tweaks.css usr/share/ArtValueReport/. verticalTabs.css usr/share/ArtValueReport/. cabal-debian-4.31/test-data/artvaluereport2/output/debian/control0000644000000000000000000002505212565162075023342 0ustar0000000000000000Source: haskell-artvaluereport2 Priority: extra Section: haskell Maintainer: Clifford Beshers Build-Depends: debhelper (>= 9) , haskell-devscripts (>= 0.8) , cdbs , ghc , ghc-prof , libghc-extra-dev (>= 1.35) , libghc-extra-prof (>= 1.35) , libghc-hjscript-dev , libghc-hjscript-prof , libghc-hatex-dev , libghc-hatex-prof , libghc-quickcheck2-dev (>= 2) , libghc-quickcheck2-prof (>= 2) , libghc-rjson-dev , libghc-rjson-prof , libghc-unixutils-dev , libghc-unixutils-prof , libghc-acid-state-dev (>= 0.6) , libghc-acid-state-prof (>= 0.6) , libghc-applicative-extras-dev (>= 0.1.5) , libghc-applicative-extras-prof (>= 0.1.5) , libghc-archive-dev (>= 1.2.9) , libghc-archive-prof (>= 1.2.9) , libghc-artvaluereport-data-dev (>= 1.66) , libghc-artvaluereport-data-prof (>= 1.66) , libghc-authenticate-dev , libghc-authenticate-prof , libghc-blaze-html-dev , libghc-blaze-html-prof , libghc-blaze-markup-dev , libghc-blaze-markup-prof , libghc-cereal-dev , libghc-cereal-prof , libghc-data-accessor-dev , libghc-data-accessor-prof , libghc-debian-dev , libghc-debian-prof , libghc-debian-packaging-dev (>= 0.8) , libghc-debian-packaging-prof (>= 0.8) , libghc-digestive-functors-dev , libghc-digestive-functors-prof , libghc-digestive-functors-happstack-dev , libghc-digestive-functors-happstack-prof , libghc-directory-tree-dev , libghc-directory-tree-prof , libghc-fb-dev , libghc-fb-prof , libghc-groom-dev , libghc-groom-prof , libghc-happstack-dev , libghc-happstack-prof , libghc-happstack-authenticate-dev , libghc-happstack-authenticate-prof , libghc-happstack-extra-dev , libghc-happstack-extra-prof , libghc-happstack-hsp-dev , libghc-happstack-hsp-prof , libghc-happstack-scaffolding-dev (>= 0.23) , libghc-happstack-scaffolding-prof (>= 0.23) , libghc-happstack-server-dev , libghc-happstack-server-prof , libghc-happstack-util-dev , libghc-happstack-util-prof , libghc-harp-dev , libghc-harp-prof , libghc-hslogger-dev , libghc-hslogger-prof , libghc-hsp-dev (>= 0.4.4) , libghc-hsp-prof (>= 0.4.4) , libghc-hsx-dev , libghc-hsx-prof , libghc-html-dev , libghc-html-prof , libghc-html-entities-dev , libghc-html-entities-prof , libghc-ixset-dev , libghc-ixset-prof , libghc-jmacro-dev (>= 0.6.2) , libghc-jmacro-prof (>= 0.6.2) , libghc-json-dev , libghc-json-prof , libghc-language-css-dev , libghc-language-css-prof , libghc-lifted-base-dev , libghc-lifted-base-prof , libghc-mtl-dev , libghc-mtl-prof , libghc-network-dev (>= 2.4) , libghc-network-prof (>= 2.4) , libghc-pandoc-dev , libghc-pandoc-prof , libghc-parsec3-dev (>= 3) | libghc-parsec2-dev (<< 3) , libghc-parsec3-prof (>= 3) | libghc-parsec2-prof (<< 3) , libghc-process-extras-dev (>= 0.5) , libghc-process-extras-prof (>= 0.5) , libghc-puremd5-dev , libghc-puremd5-prof , libghc-random-dev , libghc-random-prof , libghc-regex-compat-dev , libghc-regex-compat-prof , libghc-revision-dev , libghc-revision-prof , libghc-safe-dev , libghc-safe-prof , libghc-safecopy-dev (>= 0.5.1) , libghc-safecopy-prof (>= 0.5.1) , libghc-syb-dev , libghc-syb-prof , libghc-syb-with-class-dev , libghc-syb-with-class-prof , libghc-tagged-dev , libghc-tagged-prof , libghc-text-dev , libghc-text-prof , libghc-uniplate-dev , libghc-uniplate-prof , libghc-utf8-string-dev , libghc-utf8-string-prof , libghc-web-routes-dev , libghc-web-routes-prof , libghc-web-routes-happstack-dev , libghc-web-routes-happstack-prof , libghc-web-routes-hsp-dev , libghc-web-routes-hsp-prof , libghc-web-routes-th-dev , libghc-web-routes-th-prof Build-Depends-Indep: ghc-doc , libjs-jquery-ui (<< 1.10) , libjs-jquery , libjs-jcrop , libghc-extra-doc , libghc-hjscript-doc , libghc-hatex-doc , libghc-quickcheck2-doc (>= 2) | libghc-quickcheck1-doc (<< 2) , libghc-rjson-doc , libghc-unixutils-doc , libghc-acid-state-doc , libghc-applicative-extras-doc , libghc-archive-doc , libghc-artvaluereport-data-doc , libghc-authenticate-doc , libghc-blaze-html-doc , libghc-blaze-markup-doc , libghc-cereal-doc , libghc-data-accessor-doc , libghc-debian-doc , libghc-debian-packaging-doc , libghc-digestive-functors-doc , libghc-digestive-functors-happstack-doc , libghc-directory-tree-doc , libghc-fb-doc , libghc-groom-doc , libghc-happstack-doc , libghc-happstack-authenticate-doc , libghc-happstack-extra-doc , libghc-happstack-hsp-doc , libghc-happstack-scaffolding-doc , libghc-happstack-server-doc , libghc-happstack-util-doc , libghc-harp-doc , libghc-hslogger-doc , libghc-hsp-doc , libghc-hsx-doc , libghc-html-doc , libghc-html-entities-doc , libghc-ixset-doc , libghc-jmacro-doc , libghc-json-doc , libghc-language-css-doc , libghc-lifted-base-doc , libghc-mtl-doc , libghc-network-doc , libghc-pandoc-doc , libghc-parsec3-doc (>= 3) | libghc-parsec2-doc (<< 3) , libghc-process-extras-doc , libghc-puremd5-doc , libghc-random-doc , libghc-regex-compat-doc , libghc-revision-doc , libghc-safe-doc , libghc-safecopy-doc , libghc-syb-doc , libghc-syb-with-class-doc , libghc-tagged-doc , libghc-text-doc , libghc-uniplate-doc , libghc-utf8-string-doc , libghc-web-routes-doc , libghc-web-routes-happstack-doc , libghc-web-routes-hsp-doc , libghc-web-routes-th-doc Standards-Version: 3.9.6 Homepage: http://appraisalreportonline.com X-Description: Haskell modules for fine art appraisal applications Haskell modules for fine art appraisal applications Package: artvaluereport2-backups Architecture: any Section: misc Depends: ${haskell:Depends}, ${misc:Depends}, anacron Recommends: ${haskell:Recommends} Suggests: ${haskell:Suggests} Conflicts: ${haskell:Conflicts} Provides: ${haskell:Provides} Description: backup program for the appraisalreportonline.com site Install this somewhere other than where the server is running get automated backups of the database. Package: artvaluereport2-production Architecture: all Section: misc Depends: ${haskell:Depends}, ${misc:Depends}, apache2, libjpeg-progs, libjs-jcrop, libjs-jquery, libjs-jquery-ui, netpbm, texlive-fonts-extra, texlive-fonts-recommended, texlive-latex-extra, texlive-latex-recommended Recommends: ${haskell:Recommends} Suggests: ${haskell:Suggests} Conflicts: ${haskell:Conflicts} Provides: ${haskell:Provides} Description: ${haskell:ShortDescription}${haskell:ShortBlurb} ${haskell:LongDescription} . ${haskell:Blurb} Package: artvaluereport2-development Architecture: all Section: misc Depends: ${haskell:Depends}, ${misc:Depends}, libjpeg-progs, libjs-jcrop, libjs-jquery, libjs-jquery-ui, netpbm, texlive-fonts-extra, texlive-fonts-recommended, texlive-latex-extra, texlive-latex-recommended Recommends: ${haskell:Recommends} Suggests: ${haskell:Suggests} Conflicts: ${haskell:Conflicts} Provides: ${haskell:Provides} Description: ${haskell:ShortDescription}${haskell:ShortBlurb} ${haskell:LongDescription} . ${haskell:Blurb} Package: artvaluereport2-staging Architecture: all Section: misc Depends: ${haskell:Depends}, ${misc:Depends}, libjpeg-progs, libjs-jcrop, libjs-jquery, libjs-jquery-ui, netpbm, texlive-fonts-extra, texlive-fonts-recommended, texlive-latex-extra, texlive-latex-recommended Recommends: ${haskell:Recommends} Suggests: ${haskell:Suggests} Conflicts: ${haskell:Conflicts} Provides: ${haskell:Provides} Description: ${haskell:ShortDescription}${haskell:ShortBlurb} ${haskell:LongDescription} . ${haskell:Blurb} Package: appraisalscope Architecture: any Section: misc Depends: ${haskell:Depends}, ${misc:Depends} Recommends: ${haskell:Recommends} Suggests: ${haskell:Suggests} Conflicts: ${haskell:Conflicts} Provides: ${haskell:Provides} Description: Offline manipulation of appraisal database cabal-debian-4.31/test-data/artvaluereport2/output/debian/rules0000644000000000000000000000171212565162075023011 0ustar0000000000000000#!/usr/bin/make -f DEB_CABAL_PACKAGE = artvaluereport DEB_DEFAULT_COMPILER = ghc include /usr/share/cdbs/1/rules/debhelper.mk include /usr/share/cdbs/1/class/hlibrary.mk build/artvaluereport2-staging:: build-ghc-stamp build/artvaluereport2-production:: build-ghc-stamp build/artvaluereport2-development:: build-ghc-stamp build/artvaluereport2-backups:: build-ghc-stamp build/appraisalscope:: build-ghc-stamp binary-fixup/artvaluereport2-staging:: install -Dps dist-ghc/build/artvaluereport2-server/artvaluereport2-server debian/artvaluereport2-staging/usr/bin/artvaluereport2-staging binary-fixup/artvaluereport2-production:: install -Dps dist-ghc/build/artvaluereport2-server/artvaluereport2-server debian/artvaluereport2-production/usr/bin/artvaluereport2-production binary-fixup/artvaluereport2-development:: install -Dps dist-ghc/build/artvaluereport2-server/artvaluereport2-server debian/artvaluereport2-development/usr/bin/artvaluereport2-development cabal-debian-4.31/test-data/artvaluereport2/output/debian/artvaluereport2-staging.logrotate0000644000000000000000000000026412565162075030452 0ustar0000000000000000/var/log/artvaluereport2-staging/access.log { weekly rotate 5 compress missingok } /var/log/artvaluereport2-staging/app.log { weekly rotate 5 compress missingok } cabal-debian-4.31/test-data/artvaluereport2/output/debian/artvaluereport2-production.postinst0000644000000000000000000000053412565162075031067 0ustar0000000000000000#!/bin/sh case "$1" in configure) # Apache won't start if this directory doesn't exist mkdir -p /var/log/apache2/artvaluereport2-production # Restart apache so it sees the new file in /etc/apache2/sites-enabled /usr/sbin/a2enmod proxy /usr/sbin/a2enmod proxy_http service apache2 restart ;; esac #DEBHELPER# exit 0 cabal-debian-4.31/test-data/artvaluereport2/output/debian/artvaluereport2-staging.init0000644000000000000000000000207212565162075027414 0ustar0000000000000000#! /bin/sh -e . /lib/lsb/init-functions test -f /etc/default/artvaluereport2-staging && . /etc/default/artvaluereport2-staging case "$1" in start) test -x /usr/bin/artvaluereport2-staging || exit 0 log_begin_msg "Starting artvaluereport2-staging..." mkdir -p /srv/artvaluereport2-staging export ArtValueReport_datadir=/usr/share/ArtValueReport "start-stop-daemon" "--start" "-b" "--make-pidfile" "-d" "/srv/artvaluereport2-staging" "--exec" "/usr/bin/artvaluereport2-staging" "--pidfile" "/var/run/artvaluereport2-staging" "--" "--http-port" "9031" "--base-uri" "http://seereason.com:9031/" "--top" "/srv/artvaluereport2-staging" "--logs" "/var/log/artvaluereport2-staging" "--log-mode" "Development" "--static" "/usr/share/artvaluereport2-data" "--no-validate" log_end_msg $? ;; stop) log_begin_msg "Stopping artvaluereport2-staging..." "start-stop-daemon" "--stop" "--oknodo" "--retry=60" "--pidfile" "/var/run/artvaluereport2-staging" log_end_msg $? ;; *) log_success_msg "Usage: ${0} {start|stop}" exit 1 esac exit 0 cabal-debian-4.31/test-data/artvaluereport2/output/debian/artvaluereport2-development.logrotate0000644000000000000000000000027412565162075031341 0ustar0000000000000000/var/log/artvaluereport2-development/access.log { weekly rotate 5 compress missingok } /var/log/artvaluereport2-development/app.log { weekly rotate 5 compress missingok } cabal-debian-4.31/test-data/artvaluereport2/output/debian/artvaluereport2-production.dirs0000644000000000000000000000011112565162075030134 0ustar0000000000000000/var/log/apache2/artvaluereport2-production /etc/apache2/sites-available cabal-debian-4.31/test-data/artvaluereport2/output/debian/artvaluereport2-development.install0000644000000000000000000000104412565162075031003 0ustar0000000000000000Clouds.jpg usr/share/ArtValueReport/. DataTables-1.8.2 usr/share/ArtValueReport/. Udon.js usr/share/ArtValueReport/. blueprint usr/share/ArtValueReport/. flexbox.css usr/share/ArtValueReport/. html5sortable usr/share/ArtValueReport/. jGFeed usr/share/ArtValueReport/. jquery.blockUI usr/share/ArtValueReport/. jquery.tinyscrollbar usr/share/ArtValueReport/. searchMag.png usr/share/ArtValueReport/. theme/ArtValueReport_SunsetSpectrum.ico usr/share/ArtValueReport/. tweaks.css usr/share/ArtValueReport/. verticalTabs.css usr/share/ArtValueReport/. cabal-debian-4.31/test-data/artvaluereport2/output/debian/artvaluereport2-backups.postinst0000644000000000000000000000015312565162075030326 0ustar0000000000000000#!/bin/sh case "$1" in configure) /etc/cron.hourly/artvaluereport2-backups --initialize ;; esac cabal-debian-4.31/test-data/artvaluereport2/output/debian/artvaluereport2-backups.install0000644000000000000000000000012012565162076030104 0ustar0000000000000000dist-ghc/build/artvaluereport2-backups/artvaluereport2-backups /etc/cron.hourly cabal-debian-4.31/test-data/artvaluereport2/output/debian/artvaluereport2-staging.install0000644000000000000000000000104412565162075030115 0ustar0000000000000000Clouds.jpg usr/share/ArtValueReport/. DataTables-1.8.2 usr/share/ArtValueReport/. Udon.js usr/share/ArtValueReport/. blueprint usr/share/ArtValueReport/. flexbox.css usr/share/ArtValueReport/. html5sortable usr/share/ArtValueReport/. jGFeed usr/share/ArtValueReport/. jquery.blockUI usr/share/ArtValueReport/. jquery.tinyscrollbar usr/share/ArtValueReport/. searchMag.png usr/share/ArtValueReport/. theme/ArtValueReport_SunsetSpectrum.ico usr/share/ArtValueReport/. tweaks.css usr/share/ArtValueReport/. verticalTabs.css usr/share/ArtValueReport/. cabal-debian-4.31/test-data/artvaluereport2/output/debian/artvaluereport2-production.logrotate0000644000000000000000000000064512565162075031207 0ustar0000000000000000/var/log/apache2/artvaluereport2-production/access.log { copytruncate weekly rotate 5 compress missingok } /var/log/apache2/artvaluereport2-production/error.log { copytruncate weekly rotate 5 compress missingok } /var/log/artvaluereport2-production/access.log { weekly rotate 5 compress missingok } /var/log/artvaluereport2-production/app.log { weekly rotate 5 compress missingok } cabal-debian-4.31/test-data/artvaluereport2/output/debian/appraisalscope.install0000644000000000000000000000015012565162075026325 0ustar0000000000000000dist-ghc/build/appraisalscope/appraisalscope usr/bin dist-ghc/build/lookatareport/lookatareport usr/bin cabal-debian-4.31/test-data/artvaluereport2/output/debian/artvaluereport2-development.init0000644000000000000000000000215212565162075030301 0ustar0000000000000000#! /bin/sh -e . /lib/lsb/init-functions test -f /etc/default/artvaluereport2-development && . /etc/default/artvaluereport2-development case "$1" in start) test -x /usr/bin/artvaluereport2-development || exit 0 log_begin_msg "Starting artvaluereport2-development..." mkdir -p /srv/artvaluereport2-development export ArtValueReport_datadir=/usr/share/ArtValueReport "start-stop-daemon" "--start" "-b" "--make-pidfile" "-d" "/srv/artvaluereport2-development" "--exec" "/usr/bin/artvaluereport2-development" "--pidfile" "/var/run/artvaluereport2-development" "--" "--http-port" "9032" "--base-uri" "http://seereason.com:9032/" "--top" "/srv/artvaluereport2-development" "--logs" "/var/log/artvaluereport2-development" "--log-mode" "Development" "--static" "/usr/share/artvaluereport2-data" "--no-validate" log_end_msg $? ;; stop) log_begin_msg "Stopping artvaluereport2-development..." "start-stop-daemon" "--stop" "--oknodo" "--retry=60" "--pidfile" "/var/run/artvaluereport2-development" log_end_msg $? ;; *) log_success_msg "Usage: ${0} {start|stop}" exit 1 esac exit 0 cabal-debian-4.31/test-data/artvaluereport2/output/debian/compat0000644000000000000000000000000212565162075023131 0ustar00000000000000009 cabal-debian-4.31/test-data/artvaluereport2/output/debian/copyright0000644000000000000000000000064212565162076023671 0ustar0000000000000000Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ Upstream-Name: ArtValueReport Upstream-Contact: Clifford Beshers Source: https://hackage.haskell.org/package/ArtValueReport Files: * Copyright: (c) 2008-2011, SeeReason Partners LLC License: AllRightsReserved Files: debian/* Copyright: held by the contributors mentioned in debian/changelog License: AllRightsReserved cabal-debian-4.31/test-data/artvaluereport2/output/debian/cabalInstall/0000755000000000000000000000000012565162075024324 5ustar0000000000000000test-data/artvaluereport2/output/debian/cabalInstall/7e4b5d8641f6fae99e9ae9b2d8893bc7/0000755000000000000000000000000012565162075031031 5ustar0000000000000000cabal-debian-4.31output/debian/cabalInstall/7e4b5d8641f6fae99e9ae9b2d8893bc7/my.appraisalreportonline.com0000644000000000000000000000162012565162075036571 0ustar0000000000000000cabal-debian-4.31/test-data/artvaluereport2 ServerAdmin logic@seereason.com ServerName www.my.appraisalreportonline.com ServerAlias my.appraisalreportonline.com ErrorLog /var/log/apache2/artvaluereport2-production/error.log CustomLog /var/log/apache2/artvaluereport2-production/access.log combined ProxyRequests Off AllowEncodedSlashes NoDecode AddDefaultCharset off Order deny,allow #Allow from .example.com Deny from all #Allow from all AddDefaultCharset off Order deny,allow #Allow from .example.com #Deny from all Allow from all SetEnv proxy-sendcl 1 ProxyPass / http://127.0.0.1:9027/ nocanon ProxyPassReverse / http://127.0.0.1:9027/ cabal-debian-4.31/test-data/haskell-devscripts/0000755000000000000000000000000012565162075017617 5ustar0000000000000000cabal-debian-4.31/test-data/haskell-devscripts/debian/0000755000000000000000000000000012565162075021041 5ustar0000000000000000cabal-debian-4.31/test-data/haskell-devscripts/debian/changelog0000644000000000000000000000150512565162075022714 0ustar0000000000000000haskell-devscripts (0.8.13) experimental; urgency=low [ Joachim Breitner ] * Improve parsing of "Setup register" output, patch by David Fox * Enable creation of hoogle files, thanks to Kiwamu Okabe for the suggestion. [ Kiwamu Okabe ] * Need --html option to fix bug that --hoogle option don't output html file. * Support to create /usr/lib/ghc-doc/hoogle/*.txt for hoogle package. [ Joachim Breitner ] * Symlink hoogle’s txt files to /usr/lib/ghc-doc/hoogle/ * Bump ghc dependency to 7.6 * Bump standards version -- Joachim Breitner Mon, 08 Oct 2012 21:14:50 +0200 haskell-devscripts (0.8.12) unstable; urgency=low * Depend on ghc >= 7.4, adjusting to its haddock --interface-version behaviour. -- Joachim Breitner Sat, 04 Feb 2012 10:50:33 +0100 cabal-debian-4.31/test-data/haskell-devscripts/debian/control0000644000000000000000000000240512565162075022445 0ustar0000000000000000Source: haskell-devscripts Section: haskell Priority: extra Maintainer: Debian Haskell Group Uploaders: Marco Silva , Joachim Breitner Build-Depends: debhelper (>= 7) Build-Depends-Indep: perl Standards-Version: 3.9.4 Vcs-Darcs: http://darcs.debian.org/pkg-haskell/haskell-devscripts Vcs-Browser: http://darcs.debian.org/cgi-bin/darcsweb.cgi?r=pkg-haskell/haskell-devscripts Package: haskell-devscripts Architecture: all Depends: dctrl-tools , debhelper , dh-buildinfo , ghc (>= 7.6) , cdbs , ${misc:Depends} , html-xml-utils , hscolour (>= 1.8) , ghc-haddock (>= 7.4) Description: Tools to help Debian developers build Haskell packages This package provides a collection of scripts to help build Haskell packages for Debian. Unlike haskell-utils, this package is not expected to be installed on the machines of end users. . This package is designed to support Cabalized Haskell libraries. It is designed to build a library for each supported Debian compiler or 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. cabal-debian-4.31/test-data/haskell-devscripts/debian/rules0000644000000000000000000000143512565162075022121 0ustar0000000000000000#!/usr/bin/make -f # -*- makefile -*- # Uncomment this to turn on verbose mode. #export DH_VERBOSE=1 DEB_VERSION := $(shell dpkg-parsechangelog | egrep '^Version:' | cut -f 2 -d ' ') manpages = $(shell cat debian/manpages) %.1: %.pod pod2man -c 'Haskell devscripts documentation' -r 'Haskell devscripts $(DEB_VERSION)' $< > $@ %.1: % pod2man -c 'Haskell devscripts documentation' -r 'Haskell devscripts $(DEB_VERSION)' $< > $@ .PHONY: build build: $(manpages) install-stamp: dh install .PHONY: install install: install-stamp binary-indep-stamp: install-stamp dh binary-indep touch $@ .PHONY: binary-indep binary-indep: binary-indep-stamp .PHONY: binary-arch binary-arch: install-stamp .PHONY: binary binary: binary-indep-stamp .PHONY: clean clean: dh clean rm -f $(manpages) cabal-debian-4.31/test-data/haskell-devscripts/debian/docs0000644000000000000000000000000712565162075021711 0ustar0000000000000000README cabal-debian-4.31/test-data/haskell-devscripts/debian/dirs0000644000000000000000000000007512565162075021727 0ustar0000000000000000usr/bin usr/share/haskell-devscripts usr/share/cdbs/1/class/ cabal-debian-4.31/test-data/haskell-devscripts/debian/compat0000644000000000000000000000000212565162075022237 0ustar00000000000000007 cabal-debian-4.31/test-data/haskell-devscripts/debian/install0000644000000000000000000000036512565162075022436 0ustar0000000000000000dh_haskell_provides usr/bin/ dh_haskell_depends usr/bin/ dh_haskell_shlibdeps usr/bin/ dh_haskell_extra_depends usr/bin/ Dh_Haskell.sh usr/share/haskell-devscripts/ hlibrary.mk usr/share/cdbs/1/class cabal-debian-4.31/test-data/haskell-devscripts/debian/copyright0000644000000000000000000000023512565162075022774 0ustar0000000000000000This package was debianized by John Goerzen on Wed, 6 Oct 2004 09:46:14 -0500. Copyright information removed from this test data. cabal-debian-4.31/test-data/haskell-devscripts/debian/manpages0000644000000000000000000000013512565162075022556 0ustar0000000000000000dh_haskell_provides.1 dh_haskell_depends.1 dh_haskell_shlibdeps.1 dh_haskell_extra_depends.1 cabal-debian-4.31/test-data/haskell-devscripts/debian/source/0000755000000000000000000000000012565162075022341 5ustar0000000000000000cabal-debian-4.31/test-data/haskell-devscripts/debian/source/format0000644000000000000000000000001512565162075023550 0ustar00000000000000003.0 (native) cabal-debian-4.31/test-data/artvaluereport-data/0000755000000000000000000000000012565162075017776 5ustar0000000000000000cabal-debian-4.31/test-data/artvaluereport-data/input/0000755000000000000000000000000012565162075021135 5ustar0000000000000000cabal-debian-4.31/test-data/artvaluereport-data/input/Debianize.hs0000644000000000000000000000030712565162075023363 0ustar0000000000000000import Distribution.Debian main :: IO () main = debianize (Config { flags = defaultFlags {buildDeps = ["haskell-hsx-utils"] ++ buildDeps defaultFlags} , modifyAtoms = id }) cabal-debian-4.31/test-data/artvaluereport-data/input/artvaluereport-data.cabal0000644000000000000000000000662412565162075026117 0ustar0000000000000000Name: artvaluereport-data Version: 1.66.1 License: AllRightsReserved Copyright: (c) 2008-2011, SeeReason Partners LLC Author: David Fox Maintainer: David Fox Homepage: http://artvaluereport.com Synopsis: Data structures used by the fine art appraisal application Description: Data structures used by the fine art appraisal application Cabal-version: >= 1.2.3.0 build-type: Custom Library GHC-Options: -Wall -fno-warn-name-shadowing -- CPP-Options: -DLAZYIMAGES Extensions: CPP Exposed-modules: Appraisal.Config Appraisal.Image Appraisal.Report Appraisal.Report.Archive Appraisal.Report.BoilerPlate Appraisal.Report.IO Appraisal.Report.Item Appraisal.Report.LaTeX Appraisal.Report.Twins Appraisal.Report.Wiki Appraisal.ReportStore Appraisal.Permissions Appraisal.State Appraisal.Types Appraisal.WebConf Document.CIString Document.Classes Document.FormText Document.HaXml Document.IsText Document.LaTeX Document.Markdown Document.Unicode Document.Wiki Extra.Currency Extra.File Extra.Html Extra.Image Extra.ImageFile Extra.LaTeX Extra.List Extra.Simplify Extra.Text Extra.Trace Extra.Unicode Happstack.Server.Account Happstack.Server.Formlets Happstack.Server.Session Logger State Types.Account Types.Session Appraisal.Data.UUID Appraisal.Data.UUID.V1 Appraisal.Data.UUID.V3 Appraisal.Data.UUID.V4 Appraisal.Data.UUID.V5 Other-Modules: Appraisal.Data.UUID.Builder, Appraisal.Data.UUID.Internal, Appraisal.Data.UUID.Named Build-Depends: acid-state, applicative-extras, base, binary, bytestring, cabal-debian, cereal, containers, cryptohash >= 0.7, debian >= 3.67, directory, Extra, filepath, formlets, happstack-extra, happstack-hsp, happstack-server, happstack-util, HaTeX >= 3.4, HaXml >= 1.22.5, hslogger, hsp, hsx, html-entities >= 1.3, HUnit, ixset, ListLike, listlike-instances, maccatcher, mtl, network >= 2.4, old-time, pandoc, pandoc-types, parsec, process, process-extras >= 0.6, process-progress, pureMD5, random, regex-compat, revision >= 0.8, RJson, safecopy, syb, syb-with-class, text, time, unix, Unixutils >= 1.50, utf8-string, xhtml cabal-debian-4.31/test-data/artvaluereport-data/input/debian/0000755000000000000000000000000012565162075022357 5ustar0000000000000000cabal-debian-4.31/test-data/artvaluereport-data/input/debian/changelog0000644000000000000000000003061712565162075024240 0ustar0000000000000000haskell-artvaluereport-data (1.67) unstable; urgency=low * Add fromEpochMilli and showEpochMilli to module State. -- David Fox Fri, 25 Jan 2013 15:13:22 -0800 haskell-artvaluereport-data (1.66.2) unstable; urgency=low * Fix a place where [Client] wasn't getting expanded * Make sure there's a blank line after "Dear so-and-so" -- David Fox Fri, 18 Jan 2013 13:57:53 -0800 haskell-artvaluereport-data (1.66.1) unstable; urgency=low * Change the latex command to pdflatex. -- David Fox Mon, 17 Dec 2012 11:54:23 -0800 haskell-artvaluereport-data (1.66) unstable; urgency=low * New image processing primitives: imageIO replaced by updateOriginal, modifyOriginal, updateDerived, and modifyDerived. -- David Fox Sat, 15 Dec 2012 12:29:18 -0800 haskell-artvaluereport-data (1.65.1) unstable; urgency=low * Don't filter blank lines out of the address block * Migration to merge some items in a particular report -- David Fox Wed, 12 Dec 2012 09:37:30 -0800 haskell-artvaluereport-data (1.65) unstable; urgency=low * Rework the LaTeX generation. -- David Fox Thu, 06 Dec 2012 09:37:23 -0800 haskell-artvaluereport-data (1.64.3) unstable; urgency=low * Remove extra caption on Appraised Item Summary, make total label left justified and bold. -- David Fox Sat, 01 Dec 2012 08:45:38 -0800 haskell-artvaluereport-data (1.64.2) unstable; urgency=low * Rework the Appaised Item Summary table. -- David Fox Sat, 01 Dec 2012 07:15:51 -0800 haskell-artvaluereport-data (1.64.1) unstable; urgency=low * Move the modules from haskell-debian into this package. -- David Fox Fri, 30 Nov 2012 13:34:22 -0800 haskell-artvaluereport-data (1.64) unstable; urgency=low * Move sortElems to Appraisal.Types and export. -- David Fox Fri, 30 Nov 2012 06:47:30 -0800 haskell-artvaluereport-data (1.63.5) unstable; urgency=low * Supply a case for new ReportIntendedUse constructor * Don't allow warnings in Appraisal.Types * Remove -O0 flag from Appraisal.Types. -- David Fox Mon, 26 Nov 2012 10:30:00 -0800 haskell-artvaluereport-data (1.63.4) unstable; urgency=low * Use cabal-debian for packaging. -- David Fox Sun, 18 Nov 2012 15:51:26 -0800 haskell-artvaluereport-data (1.63.3) unstable; urgency=low * Increase width of left column on item pages -- David Fox Fri, 16 Nov 2012 10:18:50 -0800 haskell-artvaluereport-data (1.63.2) unstable; urgency=low * Sort the item entries in the generated PDF by Item Number. -- David Fox Wed, 14 Nov 2012 13:28:56 -0800 haskell-artvaluereport-data (1.63.1) unstable; urgency=low * A migration to update some report permissions, soon we will have a UI for this purpose. -- David Fox Mon, 12 Nov 2012 13:11:41 -0800 haskell-artvaluereport-data (1.63) unstable; urgency=low * Add an EstateTax constructor to ReportIntendedUse. -- David Fox Mon, 05 Nov 2012 12:01:23 -0800 haskell-artvaluereport-data (1.62) unstable; urgency=low * Another migration was necessary after all. -- Clifford Beshers Sat, 20 Oct 2012 11:20:18 -0700 haskell-artvaluereport-data (1.61) unstable; urgency=low * Hide Item AdditionalNotes field from the report generation, as it used to be. This migration should have removed constructors from ItemFieldName. The decision to leave them in was a mistake, but I'll wait until the next migration to fix it. -- Clifford Beshers Fri, 19 Oct 2012 12:49:09 -0700 haskell-artvaluereport-data (1.60) unstable; urgency=low * Bug 452: add Edition field to Item after Condition. -- Clifford Beshers Thu, 18 Oct 2012 17:02:13 -0700 haskell-artvaluereport-data (1.59) unstable; urgency=low * turn on LAZYIMAGES -- David Fox Sat, 13 Oct 2012 10:27:11 -0700 haskell-artvaluereport-data (1.58) unstable; urgency=low * Remove the local copies of the readProcess functions. -- David Fox Thu, 11 Oct 2012 13:54:55 -0700 haskell-artvaluereport-data (1.57) unstable; urgency=low * Add ifdefs to control whether we are using lazy or strict readProcess functions, set it to Lazy for now. Still using the local copies of the readProcess functions, can switch to process-extras soon. -- David Fox Thu, 11 Oct 2012 13:51:41 -0700 haskell-artvaluereport-data (1.56) unstable; urgency=low * Make all the uses of readProcess and readProcessWithExitCode the non-lazy versions. -- David Fox Thu, 11 Oct 2012 06:06:48 -0700 haskell-artvaluereport-data (1.55) unstable; urgency=low * Use the Paths class in the File and ImageFile modules. -- David Fox Mon, 08 Oct 2012 13:20:12 -0700 haskell-artvaluereport-data (1.54) unstable; urgency=low * Move the FileCache modules into this package. * Eliminate newdata and Default instances. -- David Fox Sun, 07 Oct 2012 08:11:09 -0700 haskell-artvaluereport-data (1.53.1) unstable; urgency=low * Add a PadsMonad class which provides the functionality of class Paths in a monad. -- David Fox Sat, 06 Oct 2012 16:53:28 -0700 haskell-artvaluereport-data (1.53) unstable; urgency=low * Merge Appraisal.Paths into Appraisal.Config * Clean up path handling: Replace all AVRVersion arguments with arguments that are an instance of Paths. -- David Fox Sat, 06 Oct 2012 08:37:09 -0700 haskell-artvaluereport-data (1.52) unstable; urgency=low * Add /reports/ to the report path. -- David Fox Fri, 05 Oct 2012 05:23:15 -0700 haskell-artvaluereport-data (1.51) unstable; urgency=low * Add a UUID field which will serve as a permenant identifier for the report across all the servers we might create to handle these reports. * Add report archiving and unarchiving. * Add an event to replace a report by UUID number. -- David Fox Sat, 29 Sep 2012 06:45:10 -0700 haskell-artvaluereport-data (1.50) unstable; urgency=low * All new names for the path description variables in Appraisal.Config. -- David Fox Tue, 25 Sep 2012 10:52:45 -0700 haskell-artvaluereport-data (1.49) unstable; urgency=low * Add a copy of the uuid package so we can give UUID a complete Data instance. Eventually I may have to make a uuid-data package which is a wrapper around the UUID type with that instance. -- David Fox Fri, 21 Sep 2012 08:23:56 -0700 haskell-artvaluereport-data (1.48) unstable; urgency=low * Add a UUID field to Report, and a status field that says whether the report is in an Archived state. By "Archived" we mean that a file has been downloaded to elsewhere that is assumed to contain the authoritative report data. -- David Fox Thu, 20 Sep 2012 11:20:28 -0700 haskell-artvaluereport-data (1.47) unstable; urgency=low * Strip ^M from latex text. -- David Fox Wed, 05 Sep 2012 16:20:23 -0700 haskell-artvaluereport-data (1.46) unstable; urgency=low * Change signature of Appraisal.Image.updateOriginal - the second argument was URI, now Either URI L.ByteString. -- David Fox Mon, 16 Jul 2012 13:09:25 -0700 haskell-artvaluereport-data (1.45) unstable; urgency=low * Changes for building AVR1. -- David Fox Sat, 14 Jul 2012 14:33:51 -0700 haskell-artvaluereport-data (1.44) unstable; urgency=low * Add a Appraisal.Paths module with a class that manages file locations. -- David Fox Fri, 13 Jul 2012 11:04:12 -0700 haskell-artvaluereport-data (1.43) unstable; urgency=low * Export imageIO. -- Clifford Beshers Thu, 12 Jul 2012 01:41:18 -0700 haskell-artvaluereport-data (1.42) unstable; urgency=low * Fix the paths generated for AVR2 by reportPath and updateLogo. -- David Fox Wed, 11 Jul 2012 10:04:05 -0700 haskell-artvaluereport-data (1.41) unstable; urgency=low * Add a reportBranding field to the Report type to control the logo and other branding features. -- David Fox Mon, 25 Jun 2012 10:31:04 -0700 haskell-artvaluereport-data (1.40) unstable; urgency=low * Changes to make LaTeX output more compact. -- David Fox Tue, 19 Jun 2012 09:20:12 -0700 haskell-artvaluereport-data (1.39) unstable; urgency=low * Fix a buggy SafeCopy instance in Happstack.Server.Account. -- David Fox Fri, 08 Jun 2012 09:08:16 -0700 haskell-artvaluereport-data (1.38) unstable; urgency=low * Remove signature from Privacy Policy. -- Clifford Beshers Tue, 29 May 2012 11:49:02 -0700 haskell-artvaluereport-data (1.37) unstable; urgency=low * Add an AVRVersion argument where necessary to control generation of pathnames. * Make the loge byte string a parameter. -- David Fox Tue, 01 May 2012 12:46:54 -0700 haskell-artvaluereport-data (1.36) unstable; urgency=low * Modify WebConf to match what we now use in avr2 - replaces parameters "store", "home", "cache" with just one called "top". * Don't die when we have a bad image url in an image struct, just do nothing and enter a log message. -- David Fox Mon, 02 Apr 2012 11:52:00 -0700 haskell-artvaluereport-data (1.35) unstable; urgency=low * Replace use of lazyCommand with enhanced readCommandWithExitCode from Unixutils. -- David Fox Sun, 25 Mar 2012 07:16:15 -0700 haskell-artvaluereport-data (1.34) unstable; urgency=low * Migrate the Permissions type from storing Usernames to define which users can see a report to storing UserIds. This closes a serious security hole. -- David Fox Mon, 12 Mar 2012 10:42:12 -0700 haskell-artvaluereport-data (1.33) unstable; urgency=low * Remove the leading slash from the result of the reportURI and reportBase and reportPath functions in Appraisal.Types. -- David Fox Thu, 08 Mar 2012 09:36:15 -0800 haskell-artvaluereport-data (1.32) unstable; urgency=low * Export Appraisal.Types.reportBase -- David Fox Tue, 06 Mar 2012 17:22:01 -0800 haskell-artvaluereport-data (1.31) unstable; urgency=low * Migrate old report record to new. This replaces the old reportClient field with reportClientName and reportClientAddress. It leaves two fields that are not used by the new report generator: reportFolder and revisionInfo. -- David Fox Tue, 06 Mar 2012 14:49:40 -0800 haskell-artvaluereport-data (1.30) unstable; urgency=low * Improve formatting of Appraised Item List -- David Fox Thu, 09 Feb 2012 17:09:16 -0800 haskell-artvaluereport-data (1.29) unstable; urgency=low * Remove dependencies on happstack-state * Remove version numbers from some module names * Rename deb packages -- David Fox Tue, 07 Feb 2012 06:36:44 -0800 haskell-appraisal-data (1.28) unstable; urgency=low * Move Appraisal.Permissions into artvaluereport package to avoid dependency hereon happstack-state. -- David Fox Mon, 30 Jan 2012 16:16:15 -0800 haskell-appraisal-data (1.27) unstable; urgency=low * Add an interface to change IntendedUse. -- David Fox Thu, 05 Jan 2012 20:45:40 -0800 haskell-appraisal-data (1.26) unstable; urgency=low * Make the abbreviations "ValueType", "ValueTypeDescription", "ValueTypeLongDescription", and "ValueApproachExplanation" override the values stored in the report's reportValueTypeInfo field if they are available. -- David Fox Thu, 05 Jan 2012 10:11:04 -0800 haskell-appraisal-data (1.25) unstable; urgency=low * Export module Report2. -- Clifford Beshers Thu, 08 Dec 2011 12:16:56 -0800 haskell-appraisal-data (1.24) unstable; urgency=low * Add safecopy instances. -- David Fox Sat, 19 Nov 2011 07:23:19 -0800 haskell-appraisal-data (1.23-1~hackage1) unstable; urgency=low * Debianization generated by cabal-debian -- David Fox Fri, 18 Nov 2011 09:23:34 -0800 cabal-debian-4.31/test-data/artvaluereport-data/output/0000755000000000000000000000000012565162075021336 5ustar0000000000000000cabal-debian-4.31/test-data/artvaluereport-data/output/debian/0000755000000000000000000000000012565162075022560 5ustar0000000000000000cabal-debian-4.31/test-data/artvaluereport-data/output/debian/watch0000644000000000000000000000021212565162075023604 0ustar0000000000000000version=3 http://hackage.haskell.org/package/artvaluereport-data/distro-monitor .*-([0-9\.]+)\.(?:zip|tgz|tbz|txz|(?:tar\.(?:gz|bz2|xz))) cabal-debian-4.31/test-data/artvaluereport-data/output/debian/Debianize.hs0000644000000000000000000000030712565162075025006 0ustar0000000000000000import Distribution.Debian main :: IO () main = debianize (Config { flags = defaultFlags {buildDeps = ["haskell-hsx-utils"] ++ buildDeps defaultFlags} , modifyAtoms = id }) cabal-debian-4.31/test-data/artvaluereport-data/output/debian/changelog0000644000000000000000000002774212565162075024446 0ustar0000000000000000haskell-artvaluereport-data (1.66.1) unstable; urgency=low * Change the latex command to pdflatex. -- David Fox Mon, 17 Dec 2012 11:54:23 -0800 haskell-artvaluereport-data (1.66) unstable; urgency=low * New image processing primitives: imageIO replaced by updateOriginal, modifyOriginal, updateDerived, and modifyDerived. -- David Fox Sat, 15 Dec 2012 12:29:18 -0800 haskell-artvaluereport-data (1.65.1) unstable; urgency=low * Don't filter blank lines out of the address block * Migration to merge some items in a particular report -- David Fox Wed, 12 Dec 2012 09:37:30 -0800 haskell-artvaluereport-data (1.65) unstable; urgency=low * Rework the LaTeX generation. -- David Fox Thu, 06 Dec 2012 09:37:23 -0800 haskell-artvaluereport-data (1.64.3) unstable; urgency=low * Remove extra caption on Appraised Item Summary, make total label left justified and bold. -- David Fox Sat, 01 Dec 2012 08:45:38 -0800 haskell-artvaluereport-data (1.64.2) unstable; urgency=low * Rework the Appaised Item Summary table. -- David Fox Sat, 01 Dec 2012 07:15:51 -0800 haskell-artvaluereport-data (1.64.1) unstable; urgency=low * Move the modules from haskell-debian into this package. -- David Fox Fri, 30 Nov 2012 13:34:22 -0800 haskell-artvaluereport-data (1.64) unstable; urgency=low * Move sortElems to Appraisal.Types and export. -- David Fox Fri, 30 Nov 2012 06:47:30 -0800 haskell-artvaluereport-data (1.63.5) unstable; urgency=low * Supply a case for new ReportIntendedUse constructor * Don't allow warnings in Appraisal.Types * Remove -O0 flag from Appraisal.Types. -- David Fox Mon, 26 Nov 2012 10:30:00 -0800 haskell-artvaluereport-data (1.63.4) unstable; urgency=low * Use cabal-debian for packaging. -- David Fox Sun, 18 Nov 2012 15:51:26 -0800 haskell-artvaluereport-data (1.63.3) unstable; urgency=low * Increase width of left column on item pages -- David Fox Fri, 16 Nov 2012 10:18:50 -0800 haskell-artvaluereport-data (1.63.2) unstable; urgency=low * Sort the item entries in the generated PDF by Item Number. -- David Fox Wed, 14 Nov 2012 13:28:56 -0800 haskell-artvaluereport-data (1.63.1) unstable; urgency=low * A migration to update some report permissions, soon we will have a UI for this purpose. -- David Fox Mon, 12 Nov 2012 13:11:41 -0800 haskell-artvaluereport-data (1.63) unstable; urgency=low * Add an EstateTax constructor to ReportIntendedUse. -- David Fox Mon, 05 Nov 2012 12:01:23 -0800 haskell-artvaluereport-data (1.62) unstable; urgency=low * Another migration was necessary after all. -- Clifford Beshers Sat, 20 Oct 2012 11:20:18 -0700 haskell-artvaluereport-data (1.61) unstable; urgency=low * Hide Item AdditionalNotes field from the report generation, as it used to be. This migration should have removed constructors from ItemFieldName. The decision to leave them in was a mistake, but I'll wait until the next migration to fix it. -- Clifford Beshers Fri, 19 Oct 2012 12:49:09 -0700 haskell-artvaluereport-data (1.60) unstable; urgency=low * Bug 452: add Edition field to Item after Condition. -- Clifford Beshers Thu, 18 Oct 2012 17:02:13 -0700 haskell-artvaluereport-data (1.59) unstable; urgency=low * turn on LAZYIMAGES -- David Fox Sat, 13 Oct 2012 10:27:11 -0700 haskell-artvaluereport-data (1.58) unstable; urgency=low * Remove the local copies of the readProcess functions. -- David Fox Thu, 11 Oct 2012 13:54:55 -0700 haskell-artvaluereport-data (1.57) unstable; urgency=low * Add ifdefs to control whether we are using lazy or strict readProcess functions, set it to Lazy for now. Still using the local copies of the readProcess functions, can switch to process-extras soon. -- David Fox Thu, 11 Oct 2012 13:51:41 -0700 haskell-artvaluereport-data (1.56) unstable; urgency=low * Make all the uses of readProcess and readProcessWithExitCode the non-lazy versions. -- David Fox Thu, 11 Oct 2012 06:06:48 -0700 haskell-artvaluereport-data (1.55) unstable; urgency=low * Use the Paths class in the File and ImageFile modules. -- David Fox Mon, 08 Oct 2012 13:20:12 -0700 haskell-artvaluereport-data (1.54) unstable; urgency=low * Move the FileCache modules into this package. * Eliminate newdata and Default instances. -- David Fox Sun, 07 Oct 2012 08:11:09 -0700 haskell-artvaluereport-data (1.53.1) unstable; urgency=low * Add a PadsMonad class which provides the functionality of class Paths in a monad. -- David Fox Sat, 06 Oct 2012 16:53:28 -0700 haskell-artvaluereport-data (1.53) unstable; urgency=low * Merge Appraisal.Paths into Appraisal.Config * Clean up path handling: Replace all AVRVersion arguments with arguments that are an instance of Paths. -- David Fox Sat, 06 Oct 2012 08:37:09 -0700 haskell-artvaluereport-data (1.52) unstable; urgency=low * Add /reports/ to the report path. -- David Fox Fri, 05 Oct 2012 05:23:15 -0700 haskell-artvaluereport-data (1.51) unstable; urgency=low * Add a UUID field which will serve as a permenant identifier for the report across all the servers we might create to handle these reports. * Add report archiving and unarchiving. * Add an event to replace a report by UUID number. -- David Fox Sat, 29 Sep 2012 06:45:10 -0700 haskell-artvaluereport-data (1.50) unstable; urgency=low * All new names for the path description variables in Appraisal.Config. -- David Fox Tue, 25 Sep 2012 10:52:45 -0700 haskell-artvaluereport-data (1.49) unstable; urgency=low * Add a copy of the uuid package so we can give UUID a complete Data instance. Eventually I may have to make a uuid-data package which is a wrapper around the UUID type with that instance. -- David Fox Fri, 21 Sep 2012 08:23:56 -0700 haskell-artvaluereport-data (1.48) unstable; urgency=low * Add a UUID field to Report, and a status field that says whether the report is in an Archived state. By "Archived" we mean that a file has been downloaded to elsewhere that is assumed to contain the authoritative report data. -- David Fox Thu, 20 Sep 2012 11:20:28 -0700 haskell-artvaluereport-data (1.47) unstable; urgency=low * Strip ^M from latex text. -- David Fox Wed, 05 Sep 2012 16:20:23 -0700 haskell-artvaluereport-data (1.46) unstable; urgency=low * Change signature of Appraisal.Image.updateOriginal - the second argument was URI, now Either URI L.ByteString. -- David Fox Mon, 16 Jul 2012 13:09:25 -0700 haskell-artvaluereport-data (1.45) unstable; urgency=low * Changes for building AVR1. -- David Fox Sat, 14 Jul 2012 14:33:51 -0700 haskell-artvaluereport-data (1.44) unstable; urgency=low * Add a Appraisal.Paths module with a class that manages file locations. -- David Fox Fri, 13 Jul 2012 11:04:12 -0700 haskell-artvaluereport-data (1.43) unstable; urgency=low * Export imageIO. -- Clifford Beshers Thu, 12 Jul 2012 01:41:18 -0700 haskell-artvaluereport-data (1.42) unstable; urgency=low * Fix the paths generated for AVR2 by reportPath and updateLogo. -- David Fox Wed, 11 Jul 2012 10:04:05 -0700 haskell-artvaluereport-data (1.41) unstable; urgency=low * Add a reportBranding field to the Report type to control the logo and other branding features. -- David Fox Mon, 25 Jun 2012 10:31:04 -0700 haskell-artvaluereport-data (1.40) unstable; urgency=low * Changes to make LaTeX output more compact. -- David Fox Tue, 19 Jun 2012 09:20:12 -0700 haskell-artvaluereport-data (1.39) unstable; urgency=low * Fix a buggy SafeCopy instance in Happstack.Server.Account. -- David Fox Fri, 08 Jun 2012 09:08:16 -0700 haskell-artvaluereport-data (1.38) unstable; urgency=low * Remove signature from Privacy Policy. -- Clifford Beshers Tue, 29 May 2012 11:49:02 -0700 haskell-artvaluereport-data (1.37) unstable; urgency=low * Add an AVRVersion argument where necessary to control generation of pathnames. * Make the loge byte string a parameter. -- David Fox Tue, 01 May 2012 12:46:54 -0700 haskell-artvaluereport-data (1.36) unstable; urgency=low * Modify WebConf to match what we now use in avr2 - replaces parameters "store", "home", "cache" with just one called "top". * Don't die when we have a bad image url in an image struct, just do nothing and enter a log message. -- David Fox Mon, 02 Apr 2012 11:52:00 -0700 haskell-artvaluereport-data (1.35) unstable; urgency=low * Replace use of lazyCommand with enhanced readCommandWithExitCode from Unixutils. -- David Fox Sun, 25 Mar 2012 07:16:15 -0700 haskell-artvaluereport-data (1.34) unstable; urgency=low * Migrate the Permissions type from storing Usernames to define which users can see a report to storing UserIds. This closes a serious security hole. -- David Fox Mon, 12 Mar 2012 10:42:12 -0700 haskell-artvaluereport-data (1.33) unstable; urgency=low * Remove the leading slash from the result of the reportURI and reportBase and reportPath functions in Appraisal.Types. -- David Fox Thu, 08 Mar 2012 09:36:15 -0800 haskell-artvaluereport-data (1.32) unstable; urgency=low * Export Appraisal.Types.reportBase -- David Fox Tue, 06 Mar 2012 17:22:01 -0800 haskell-artvaluereport-data (1.31) unstable; urgency=low * Migrate old report record to new. This replaces the old reportClient field with reportClientName and reportClientAddress. It leaves two fields that are not used by the new report generator: reportFolder and revisionInfo. -- David Fox Tue, 06 Mar 2012 14:49:40 -0800 haskell-artvaluereport-data (1.30) unstable; urgency=low * Improve formatting of Appraised Item List -- David Fox Thu, 09 Feb 2012 17:09:16 -0800 haskell-artvaluereport-data (1.29) unstable; urgency=low * Remove dependencies on happstack-state * Remove version numbers from some module names * Rename deb packages -- David Fox Tue, 07 Feb 2012 06:36:44 -0800 haskell-appraisal-data (1.28) unstable; urgency=low * Move Appraisal.Permissions into artvaluereport package to avoid dependency hereon happstack-state. -- David Fox Mon, 30 Jan 2012 16:16:15 -0800 haskell-appraisal-data (1.27) unstable; urgency=low * Add an interface to change IntendedUse. -- David Fox Thu, 05 Jan 2012 20:45:40 -0800 haskell-appraisal-data (1.26) unstable; urgency=low * Make the abbreviations "ValueType", "ValueTypeDescription", "ValueTypeLongDescription", and "ValueApproachExplanation" override the values stored in the report's reportValueTypeInfo field if they are available. -- David Fox Thu, 05 Jan 2012 10:11:04 -0800 haskell-appraisal-data (1.25) unstable; urgency=low * Export module Report2. -- Clifford Beshers Thu, 08 Dec 2011 12:16:56 -0800 haskell-appraisal-data (1.24) unstable; urgency=low * Add safecopy instances. -- David Fox Sat, 19 Nov 2011 07:23:19 -0800 haskell-appraisal-data (1.23-1~hackage1) unstable; urgency=low * Debianization generated by cabal-debian -- David Fox Fri, 18 Nov 2011 09:23:34 -0800 cabal-debian-4.31/test-data/artvaluereport-data/output/debian/control0000644000000000000000000001525512565162075024173 0ustar0000000000000000Source: haskell-artvaluereport-data Priority: extra Section: haskell Maintainer: David Fox Build-Depends: debhelper (>= 9) , haskell-devscripts (>= 0.8) , cdbs , ghc , ghc-prof , haskell-hsx-utils , libghc-extra-dev , libghc-extra-prof , libghc-hunit-dev , libghc-hunit-prof , libghc-hatex-dev (>= 3.4) , libghc-hatex-prof (>= 3.4) , libghc-haxml-dev (>= 1:1.22.5) , libghc-haxml-prof (>= 1:1.22.5) , libghc-listlike-dev , libghc-listlike-prof , libghc-rjson-dev , libghc-rjson-prof , libghc-unixutils-dev (>= 1.50) , libghc-unixutils-prof (>= 1.50) , libghc-acid-state-dev , libghc-acid-state-prof , libghc-applicative-extras-dev , libghc-applicative-extras-prof , libghc-cabal-debian-dev , libghc-cabal-debian-prof , libghc-cereal-dev , libghc-cereal-prof , libghc-cryptohash-dev (>= 0.7) , libghc-cryptohash-prof (>= 0.7) , libghc-debian-dev (>= 3.67) , libghc-debian-prof (>= 3.67) , libghc-formlets-dev , libghc-formlets-prof , libghc-happstack-extra-dev , libghc-happstack-extra-prof , libghc-happstack-hsp-dev , libghc-happstack-hsp-prof , libghc-happstack-server-dev , libghc-happstack-server-prof , libghc-happstack-util-dev , libghc-happstack-util-prof , libghc-hslogger-dev , libghc-hslogger-prof , libghc-hsp-dev , libghc-hsp-prof , libghc-hsx-dev , libghc-hsx-prof , libghc-html-entities-dev (>= 1.3) , libghc-html-entities-prof (>= 1.3) , libghc-ixset-dev , libghc-ixset-prof , libghc-listlike-instances-dev , libghc-listlike-instances-prof , libghc-maccatcher-dev , libghc-maccatcher-prof , libghc-mtl-dev , libghc-mtl-prof , libghc-network-dev (>= 2.4) , libghc-network-prof (>= 2.4) , libghc-pandoc-dev , libghc-pandoc-prof , libghc-pandoc-types-dev , libghc-pandoc-types-prof , libghc-parsec3-dev (>= 3) | libghc-parsec2-dev (<< 3) , libghc-parsec3-prof (>= 3) | libghc-parsec2-prof (<< 3) , libghc-process-extras-dev (>= 0.6) , libghc-process-extras-prof (>= 0.6) , libghc-process-progress-dev , libghc-process-progress-prof , libghc-puremd5-dev , libghc-puremd5-prof , libghc-random-dev , libghc-random-prof , libghc-regex-compat-dev , libghc-regex-compat-prof , libghc-revision-dev (>= 0.8) , libghc-revision-prof (>= 0.8) , libghc-safecopy-dev , libghc-safecopy-prof , libghc-syb-dev , libghc-syb-prof , libghc-syb-with-class-dev , libghc-syb-with-class-prof , libghc-text-dev , libghc-text-prof , libghc-utf8-string-dev , libghc-utf8-string-prof Build-Depends-Indep: ghc-doc , libghc-extra-doc , libghc-hunit-doc , libghc-hatex-doc , libghc-haxml-doc , libghc-listlike-doc , libghc-rjson-doc , libghc-unixutils-doc , libghc-acid-state-doc , libghc-applicative-extras-doc , libghc-cabal-debian-doc , libghc-cereal-doc , libghc-cryptohash-doc , libghc-debian-doc , libghc-formlets-doc , libghc-happstack-extra-doc , libghc-happstack-hsp-doc , libghc-happstack-server-doc , libghc-happstack-util-doc , libghc-hslogger-doc , libghc-hsp-doc , libghc-hsx-doc , libghc-html-entities-doc , libghc-ixset-doc , libghc-listlike-instances-doc , libghc-maccatcher-doc , libghc-mtl-doc , libghc-network-doc , libghc-pandoc-doc , libghc-pandoc-types-doc , libghc-parsec3-doc (>= 3) | libghc-parsec2-doc (<< 3) , libghc-process-extras-doc , libghc-process-progress-doc , libghc-puremd5-doc , libghc-random-doc , libghc-regex-compat-doc , libghc-revision-doc , libghc-safecopy-doc , libghc-syb-doc , libghc-syb-with-class-doc , libghc-text-doc , libghc-utf8-string-doc Standards-Version: 3.9.6 Homepage: http://artvaluereportonline.com X-Description: Data structures used by the fine art appraisal application Data structures used by the fine art appraisal application Package: libghc-artvaluereport-data-dev Architecture: any Depends: ${haskell:Depends} , ${misc:Depends} , ${shlibs:Depends} Conflicts: ${haskell:Conflicts} Provides: ${haskell:Provides} Recommends: ${haskell:Recommends} Suggests: ${haskell:Suggests} Description: ${haskell:ShortDescription}${haskell:ShortBlurb} ${haskell:LongDescription} . ${haskell:Blurb} Package: libghc-artvaluereport-data-prof Architecture: any Depends: ${haskell:Depends} , ${misc:Depends} Conflicts: ${haskell:Conflicts} Provides: ${haskell:Provides} Recommends: ${haskell:Recommends} Suggests: ${haskell:Suggests} Description: ${haskell:ShortDescription}${haskell:ShortBlurb} ${haskell:LongDescription} . ${haskell:Blurb} Package: libghc-artvaluereport-data-doc Architecture: all Section: doc Depends: ${haskell:Depends} , ${misc:Depends} Conflicts: ${haskell:Conflicts} Recommends: ${haskell:Recommends} Suggests: ${haskell:Suggests} Description: ${haskell:ShortDescription}${haskell:ShortBlurb} ${haskell:LongDescription} . ${haskell:Blurb} cabal-debian-4.31/test-data/artvaluereport-data/output/debian/rules0000644000000000000000000000026112565162075023634 0ustar0000000000000000#!/usr/bin/make -f DEB_CABAL_PACKAGE = artvaluereport-data DEB_DEFAULT_COMPILER = ghc include /usr/share/cdbs/1/rules/debhelper.mk include /usr/share/cdbs/1/class/hlibrary.mk cabal-debian-4.31/test-data/artvaluereport-data/output/debian/extra-depends0000644000000000000000000000000112565162075025235 0ustar0000000000000000 cabal-debian-4.31/test-data/artvaluereport-data/output/debian/compat0000644000000000000000000000000212565162075023756 0ustar00000000000000009 cabal-debian-4.31/test-data/artvaluereport-data/output/debian/copyright0000644000000000000000000000064112565162075024514 0ustar0000000000000000Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ Upstream-Name: artvaluereport-data Upstream-Contact: David Fox Source: https://hackage.haskell.org/package/artvaluereport-data Files: * Copyright: (c) 2008-2011, SeeReason Partners LLC License: AllRightsReserved Files: debian/* Copyright: held by the contributors mentioned in debian/changelog License: AllRightsReserved cabal-debian-4.31/test-data/artvaluereport-data/output/debian/source/0000755000000000000000000000000012565162075024060 5ustar0000000000000000cabal-debian-4.31/test-data/artvaluereport-data/output/debian/source/format0000644000000000000000000000001512565162075025267 0ustar00000000000000003.0 (native) cabal-debian-4.31/test-data/archive/0000755000000000000000000000000012565162075015431 5ustar0000000000000000cabal-debian-4.31/test-data/archive/input/0000755000000000000000000000000012565162075016570 5ustar0000000000000000cabal-debian-4.31/test-data/archive/input/seereason-darcs-backups.cabal0000644000000000000000000000155312565162075024264 0ustar0000000000000000Name: seereason-darcs-backups Version: 0.9 License: AllRightsReserved License-File: debian/copyright Copyright: (c) 2010-2011, SeeReason Partners LLC Author: SeeReason Partners Maintainer: SeeReason Partners Synopsis: Backups of the seereason darcs repositories Description: Install this somewhere other than where the server is running get automated backups of the database. Build-Type: Custom Category: Web, Language Cabal-version: >= 1.2 Executable seereason-darcs-backups Main-Is: Backups.hs GHC-Options: -threaded -Wall -Wwarn -O2 -fno-warn-name-shadowing -fno-warn-missing-signatures -fwarn-tabs -fno-warn-unused-binds -fno-warn-orphans -fwarn-unused-imports -fno-spec-constr Build-depends: archive >= 1.7, base, Extra, network cabal-debian-4.31/test-data/archive/input/debian/0000755000000000000000000000000012565162075020012 5ustar0000000000000000cabal-debian-4.31/test-data/archive/input/debian/changelog0000644000000000000000000000050412565162075021663 0ustar0000000000000000seereason-darcs-backups (0.9) unstable; urgency=low * New package to pull backups of our darcs repositories from our server, and eventually anything else which is precious and not otherwise backed up. * Debianization generated by cabal-debian -- David Fox Sat, 23 Nov 2013 07:27:06 -0800 cabal-debian-4.31/test-data/archive/input/debian/copyright0000644000000000000000000000021612565162075021744 0ustar0000000000000000This package is not part of the Debian GNU/Linux distribution. Copyright: (c) 2010-2011, SeeReason Partners LLC License: All Rights Reserved cabal-debian-4.31/test-data/archive/output/0000755000000000000000000000000012565162075016771 5ustar0000000000000000cabal-debian-4.31/test-data/archive/output/debian/0000755000000000000000000000000012565162075020213 5ustar0000000000000000cabal-debian-4.31/test-data/archive/output/debian/watch0000644000000000000000000000021612565162075021243 0ustar0000000000000000version=3 http://hackage.haskell.org/package/seereason-darcs-backups/distro-monitor .*-([0-9\.]+)\.(?:zip|tgz|tbz|txz|(?:tar\.(?:gz|bz2|xz))) cabal-debian-4.31/test-data/archive/output/debian/changelog0000644000000000000000000000050412565162075022064 0ustar0000000000000000seereason-darcs-backups (0.9) unstable; urgency=low * New package to pull backups of our darcs repositories from our server, and eventually anything else which is precious and not otherwise backed up. * Debianization generated by cabal-debian -- David Fox Sat, 23 Nov 2013 07:27:06 -0800 cabal-debian-4.31/test-data/archive/output/debian/control0000644000000000000000000000223012565162075021613 0ustar0000000000000000Source: seereason-darcs-backups Priority: extra Maintainer: David Fox Section: haskell Build-Depends: debhelper (>= 9) , haskell-devscripts (>= 0.8) , cdbs , ghc , ghc-prof , libghc-extra-dev , libghc-extra-prof , libghc-archive-dev (>= 1.7) , libghc-archive-prof (>= 1.7) , libghc-network-dev , libghc-network-prof Build-Depends-Indep: ghc-doc , libghc-extra-doc , libghc-archive-doc , libghc-network-doc Standards-Version: 3.8.1 X-Description: Backups of the seereason darcs repositories Install this somewhere other than where the server is running get automated backups of the database. Package: seereason-darcs-backups Architecture: any Section: misc Depends: ${haskell:Depends}, ${misc:Depends}, anacron Recommends: ${haskell:Recommends} Suggests: ${haskell:Suggests} Conflicts: ${haskell:Conflicts} Provides: ${haskell:Provides} Description: ${haskell:ShortDescription}${haskell:ShortBlurb} ${haskell:LongDescription} . ${haskell:Blurb} cabal-debian-4.31/test-data/archive/output/debian/rules0000644000000000000000000000034612565162075021273 0ustar0000000000000000#!/usr/bin/make -f DEB_CABAL_PACKAGE = seereason-darcs-backups DEB_DEFAULT_COMPILER = ghc include /usr/share/cdbs/1/rules/debhelper.mk include /usr/share/cdbs/1/class/hlibrary.mk build/seereason-darcs-backups:: build-ghc-stamp cabal-debian-4.31/test-data/archive/output/debian/seereason-darcs-backups.install0000644000000000000000000000012012565162075026300 0ustar0000000000000000dist-ghc/build/seereason-darcs-backups/seereason-darcs-backups /etc/cron.hourly cabal-debian-4.31/test-data/archive/output/debian/compat0000644000000000000000000000000212565162075021411 0ustar00000000000000009 cabal-debian-4.31/test-data/archive/output/debian/copyright0000644000000000000000000000021612565162075022145 0ustar0000000000000000This package is not part of the Debian GNU/Linux distribution. Copyright: (c) 2010-2011, SeeReason Partners LLC License: All Rights Reserved cabal-debian-4.31/test-data/alex/0000755000000000000000000000000012565162075014741 5ustar0000000000000000cabal-debian-4.31/test-data/alex/input/0000755000000000000000000000000012565162075016100 5ustar0000000000000000cabal-debian-4.31/test-data/alex/input/alex.cabal0000644000000000000000000000403412565162075020016 0ustar0000000000000000name: alex version: 3.0.2 license: BSD3 license-file: LICENSE copyright: (c) Chis Dornan, Simon Marlow author: Chris Dornan and Simon Marlow maintainer: Simon Marlow bug-reports: mailto:marlowsd@gmail.com stability: stable homepage: http://www.haskell.org/alex/ synopsis: Alex is a tool for generating lexical analysers in Haskell category: Development cabal-version: >= 1.6 build-type: Custom extra-source-files: ANNOUNCE README TODO alex.spec doc/Makefile doc/aclocal.m4 doc/alex.1.in doc/alex.xml doc/config.mk.in doc/configure.ac doc/docbook-xml.mk doc/fptools.css examples/Makefile examples/Tokens.x examples/Tokens_gscan.x examples/Tokens_posn.x examples/examples.x examples/haskell.x examples/lit.x examples/pp.x examples/state.x examples/tiny.y examples/tkns.hs examples/words.x examples/words_monad.x examples/words_posn.x src/Parser.y src/Scan.hs src/ghc_hooks.c templates/GenericTemplate.hs templates/Makefile templates/wrappers.hs tests/Makefile tests/simple.x tests/tokens.x tests/tokens_gscan.x tests/tokens_posn.x tests/tokens_bytestring.x tests/tokens_posn_bytestring.x tests/tokens_strict_bytestring.x tests/unicode.x source-repository head type: git location: https://github.com/simonmar/alex.git flag small_base description: Choose the new smaller, split-up base package. executable alex hs-source-dirs: src main-is: Main.hs if flag(small_base) build-depends: base >= 2.1, array, containers, directory else build-depends: base >= 1.0 build-depends: base < 5 -- build-depends: Ranged-sets build-depends: QuickCheck >=2 extensions: CPP ghc-options: -Wall -rtsopts other-modules: AbsSyn CharSet DFA DFAMin DFS Info Main Map NFA Output Parser ParseMonad Scan Set Sort Util UTF8 Data.Ranged Data.Ranged.Boundaries Data.Ranged.RangedSet Data.Ranged.Ranges cabal-debian-4.31/test-data/alex/input/LICENSE0000644000000000000000000000301712565162075017106 0ustar0000000000000000Copyright (c) 1995-2011, Chris Dornan and Simon Marlow All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the copyright holders, nor the names of the contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. cabal-debian-4.31/test-data/alex/output/0000755000000000000000000000000012565162075016301 5ustar0000000000000000cabal-debian-4.31/test-data/alex/output/debian/0000755000000000000000000000000012565162075017523 5ustar0000000000000000cabal-debian-4.31/test-data/alex/output/debian/watch0000644000000000000000000000017312565162075020555 0ustar0000000000000000version=3 http://hackage.haskell.org/package/alex/distro-monitor .*-([0-9\.]+)\.(?:zip|tgz|tbz|txz|(?:tar\.(?:gz|bz2|xz))) cabal-debian-4.31/test-data/alex/output/debian/changelog0000644000000000000000000000024512565162075021376 0ustar0000000000000000haskell-alex (3.0.2-1~hackage1) UNRELEASED; urgency=low * Initial release (Closes: #nnnn) -- Simon Marlow Thu, 31 Jan 2013 10:51:47 -0800 cabal-debian-4.31/test-data/alex/output/debian/control0000644000000000000000000000165412565162075021134 0ustar0000000000000000Source: haskell-alex Priority: extra Section: haskell Maintainer: Simon Marlow Build-Depends: debhelper (>= 9), haskell-devscripts (>= 0.8), cdbs, ghc, ghc-prof, alex, libghc-quickcheck2-dev (>= 2), libghc-quickcheck2-prof (>= 2), Build-Depends-Indep: ghc-doc , libghc-quickcheck2-doc (>= 2) | libghc-quickcheck1-doc (<< 2) Standards-Version: 3.9.6 Homepage: http://www.haskell.org/alex/ X-Description: Alex is a tool for generating lexical analysers in Haskell Package: alex Architecture: any Section: misc Depends: ${haskell:Depends}, ${misc:Depends}, Recommends: ${haskell:Recommends} Suggests: ${haskell:Suggests} Conflicts: ${haskell:Conflicts} Provides: ${haskell:Provides} Description: ${haskell:ShortDescription}${haskell:ShortBlurb} ${haskell:LongDescription} . ${haskell:Blurb} cabal-debian-4.31/test-data/alex/output/debian/rules0000644000000000000000000000030012565162075020571 0ustar0000000000000000#!/usr/bin/make -f DEB_CABAL_PACKAGE = alex DEB_DEFAULT_COMPILER = ghc include /usr/share/cdbs/1/rules/debhelper.mk include /usr/share/cdbs/1/class/hlibrary.mk build/alex:: build-ghc-stamp cabal-debian-4.31/test-data/alex/output/debian/alex.install0000644000000000000000000000112312565162075022041 0ustar0000000000000000AlexTemplate usr/share/alex/. AlexTemplate-debug usr/share/alex/. AlexTemplate-ghc usr/share/alex/. AlexTemplate-ghc-debug usr/share/alex/. AlexWrapper-basic usr/share/alex/. AlexWrapper-basic-bytestring usr/share/alex/. AlexWrapper-gscan usr/share/alex/. AlexWrapper-monad usr/share/alex/. AlexWrapper-monad-bytestring usr/share/alex/. AlexWrapper-monadUserState usr/share/alex/. AlexWrapper-monadUserState-bytestring usr/share/alex/. AlexWrapper-posn usr/share/alex/. AlexWrapper-posn-bytestring usr/share/alex/. AlexWrapper-strict-bytestring usr/share/alex/. dist-ghc/build/alex/alex usr/bin cabal-debian-4.31/test-data/alex/output/debian/compat0000644000000000000000000000000212565162075020721 0ustar00000000000000009 cabal-debian-4.31/test-data/alex/output/debian/copyright0000644000000000000000000000365612565162075021470 0ustar0000000000000000Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ Upstream-Name: alex Upstream-Contact: Simon Marlow Source: https://hackage.haskell.org/package/alex Files: * Copyright: (c) Chis Dornan, Simon Marlow License: BSD3 Files: debian/* Copyright: held by the contributors mentioned in debian/changelog License: BSD3 License: BSD3 Comment: Copyright (c) 1995-2011, Chris Dornan and Simon Marlow All rights reserved. . Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: . * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. . * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. . * Neither the name of the copyright holders, nor the names of the contributors may be used to endorse or promote products derived from this software without specific prior written permission. . THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. cabal-debian-4.31/test-data/alex/output/debian/source/0000755000000000000000000000000012565162075021023 5ustar0000000000000000cabal-debian-4.31/test-data/alex/output/debian/source/format0000644000000000000000000000001512565162075022232 0ustar00000000000000003.0 (native) cabal-debian-4.31/src/0000755000000000000000000000000012565162075012711 5ustar0000000000000000cabal-debian-4.31/src/Data/0000755000000000000000000000000012565162075013562 5ustar0000000000000000cabal-debian-4.31/src/Data/Maybe/0000755000000000000000000000000012565162075014617 5ustar0000000000000000cabal-debian-4.31/src/Data/Maybe/Extended.hs0000644000000000000000000000026512565162075016716 0ustar0000000000000000module Data.Maybe.Extended ( module Data.Maybe, nothingIf ) where import Data.Maybe nothingIf :: (a -> Bool) -> a -> Maybe a nothingIf p x = if p x then Nothing else Just x cabal-debian-4.31/src/Debian/0000755000000000000000000000000012565162075014073 5ustar0000000000000000cabal-debian-4.31/src/Debian/Debianize.hs0000644000000000000000000001501712565162075016325 0ustar0000000000000000-- | [/QUICK START:/] -- -- You can either run @cabal-debian@, or -- for more power and flexibility you can put a @Debianize.hs@ script in -- the package's @debian@ subdirectory. -- -- To see what your debianization would produce, or how it differs -- from the debianization already present: -- -- > % cabal-debian -n -- -- This is equivalent to the library call -- -- > % ghc -e 'System.Environment.withArgs ["-n"] $ Debian.Debianize.performDebianization Debian.Debianize.debianDefaults' -- -- To actually create the debianization and then build the debs, -- -- > % ghc -e 'Debian.Debianize.performDebianization Debian.Debianize.debianDefaults' -- > % sudo dpkg-buildpackage -- -- At this point you may need a script to achieve specific packaging -- goals. Put this this in debian/Debianize.hs: -- -- > import Control.Lens -- > import Data.Map as Map -- > import Data.Set as Set -- > import Debian.Relation (BinPkgName(BinPkgName), Relation(Rel)) -- > import Debian.Debianize -- > main = performDebianization $ do -- > debianDefaults -- > (debInfo . binaryDebDescription (BinPkgName "cabal-debian") . relations . depends) %= (++ (rels "apt-file, debian-policy, debhelper, haskell-devscripts (>= 0.8.19)")) -- -- Then to test it, -- -- > % runhaskell debian/Debianize.hs -n -- -- and to run it for real: -- -- > % runhaskell debian/Debianize.hs -- -- [/DESIGN OVERVIEW/] -- -- The three phases of the operation of the system are Input -> Finalization -> Output. -- -- [Input] Module "Debian.Debianize.Input" - gather inputs using IO -- operations and customization functions, from the .cabal file, an -- existing debianization, and so on. This information results in -- a value of type @Atoms@. Modules @Types@, @Lenses@, @Inputs@. -- -- [Customize] Make modifications to the input values -- -- [Finalization] Module "Debian.Debianize.Finalize" - Fill in any -- information missing from @Atoms@ that is required to build the -- debianization based on the inputs and our policy decisions. -- -- [Debianize] Module "Debian.Debianize.Files" - Compute the paths -- and files of the debianization from the Atoms value. -- -- [Output] Module "Debian.Debianize.Output" - Perform a variety of -- output operations on the debianzation - writing or updating the -- files in a debian directory, comparing two debianizations, -- validate a debianization (ensure two debianizations match in -- source and binary package names), or describe a debianization. -- -- There is also a high level function to run a script that runs this -- entire pipeline when it finds from a script found in a -- debian/Debianize.hs file. module Debian.Debianize ( -- * Collect information about desired debianization module Debian.Debianize.BasicInfo , module Debian.Debianize.DebInfo , module Debian.Debianize.SourceDebDescription , module Debian.Debianize.BinaryDebDescription , module Debian.Debianize.CopyrightDescription , module Debian.Debianize.CabalInfo -- * State monads to carry the collected information, command line options , module Debian.Debianize.Monad -- * Functions for maping Cabal name and version number to Debian name , module Debian.Debianize.DebianName -- * Specific details about the particular packages and versions in the Debian repo , module Debian.Debianize.Details -- * Functions to configure some useful packaging idioms - web server packages, -- tight install dependencies, etc. , module Debian.Debianize.Goodies -- * IO functions for reading debian or cabal packaging info , module Debian.Debianize.InputDebian , module Debian.Debianize.InputCabal -- * Finish computing the debianization and output the result -- , module Debian.Debianize.Finalize , module Debian.Debianize.Output -- * Utility functions , module Debian.Debianize.Prelude , module Debian.Debianize.VersionSplits , module Debian.Policy ) where import Debian.Debianize.CabalInfo -- (debianNameMap, debInfo, epochMap, newAtoms, packageDescription, PackageInfo, packageInfo, showAtoms) import Debian.Debianize.BasicInfo import Debian.Debianize.BinaryDebDescription import Debian.Debianize.CopyrightDescription import Debian.Debianize.DebInfo -- (Atom(..), atomSet, changelog, compat, control, copyright, DebInfo, file, flags, install, installCabalExec, installCabalExecTo, installData, installDir, installInit, installTo, intermediateFiles, link, logrotateStanza, makeDebInfo, postInst, postRm, preInst, preRm, rulesFragments, rulesHead, rulesIncludes, rulesSettings, sourceFormat, warning, watch, apacheSite, backups, buildDir, comments, debVersion, execMap, executable, extraDevDeps, extraLibMap, InstallFile(..), maintainerOption, missingDependencies, noDocumentationLibrary, noProfilingLibrary, official, omitLTDeps, omitProfVersionDeps, revision, Server(..), serverInfo, Site(..), sourceArchitectures, sourcePackageName, uploadersOption, utilsPackageNameBase, website, xDescription, overrideDebianNameBase) import Debian.Debianize.DebianName (mapCabal, splitCabal, remapCabal) import Debian.Debianize.Details (debianDefaults) --import Debian.Debianize.Finalize (debianize) import Debian.Debianize.Goodies -- (doBackups, doExecutable, doServer, doWebsite, tightDependencyFixup) import Debian.Debianize.InputDebian (inputChangeLog, inputDebianization, inputDebianizationFile) import Debian.Debianize.InputCabal (inputCabalization) import Debian.Debianize.Monad (CabalM, CabalT, evalCabalM, evalCabalT, execCabalM, execCabalT, runCabalM, runCabalT, DebianT, execDebianT, evalDebianT, liftCabal) import Debian.Debianize.Output (compareDebianization, describeDebianization, finishDebianization, performDebianization, runDebianizeScript, validateDebianization, writeDebianization) 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(..), MultiArch(..), parseMaintainer, parsePackageArchitectures, parseStandardsVersion, parseUploaders, readLicense, readPriority, readSection, readMultiArch, readSourceFormat, Section(..), serverAccessLog, serverAppLog, serverLogDirectory, SourceFormat(..), StandardsVersion(..), toCabalLicense) cabal-debian-4.31/src/Debian/Policy.hs0000644000000000000000000004303612565162075015674 0ustar0000000000000000-- | Code pulled out of cabal-debian that straightforwardly implements -- parts of the Debian policy manual, or other bits of Linux standards. {-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances, OverloadedStrings #-} module Debian.Policy ( -- * Paths databaseDirectory , dataDirectory , apacheLogDirectory , apacheErrorLog , apacheAccessLog , serverLogDirectory , serverAppLog , serverAccessLog , errorLogBaseName , appLogBaseName , accessLogBaseName -- * Installed packages , debianPackageVersion , getDebhelperCompatLevel , StandardsVersion(..) , getDebianStandardsVersion , parseStandardsVersion -- * Package fields , SourceFormat(..) , readSourceFormat , PackagePriority(..) , readPriority , PackageArchitectures(..) , parsePackageArchitectures , Section(..) , readSection , MultiArch(..) , readMultiArch , Area(..) , parseUploaders , parseMaintainer , maintainerOfLastResort , getCurrentDebianUser , haskellMaintainer , License(..) , fromCabalLicense , toCabalLicense , readLicense ) where import Codec.Binary.UTF8.String (decodeString) import Control.Arrow (second) import Control.Monad (mplus) import Data.Char (isSpace, toLower) import Data.Generics (Data, Typeable) import Data.List (groupBy, intercalate) import Data.Maybe (fromMaybe, mapMaybe) import Data.Monoid ((<>)) import Data.Text (pack, strip, Text, unpack) import Debian.Debianize.Prelude (read') import Debian.Pretty (PP(..)) import Debian.Relation (BinPkgName) import Debian.Version (DebianVersion, parseDebianVersion, version) import qualified Distribution.License as Cabal (License(..)) import Distribution.Package (PackageIdentifier(pkgName)) import Distribution.PackageDescription (PackageDescription(package)) import Distribution.Text (display) import System.Environment (getEnvironment) import System.FilePath (()) import System.Process (readProcess) import Text.Parsec (parse) import Text.ParserCombinators.Parsec.Rfc2822 (address, NameAddr(..)) import Text.PrettyPrint.HughesPJClass (Pretty(pPrint), text) import Text.Read (readMaybe) databaseDirectory :: BinPkgName -> String databaseDirectory x = "/srv" show (pPrint . PP $ x) dataDirectory :: PackageDescription -> String dataDirectory pkgDesc = "/usr/share" showPkgName (pkgName (package pkgDesc)) where -- Copied from Distribution.Simple.Build.PatsModule in Cabal showPkgName = map fixchar . display fixchar '-' = '_' fixchar c = c apacheLogDirectory :: BinPkgName -> String apacheLogDirectory x = "/var/log/apache2/" ++ show (pPrint . PP $ x) apacheErrorLog :: BinPkgName -> String apacheErrorLog x = apacheLogDirectory x errorLogBaseName apacheAccessLog :: BinPkgName -> String apacheAccessLog x = apacheLogDirectory x accessLogBaseName serverLogDirectory :: BinPkgName -> String serverLogDirectory x = "/var/log/" ++ show (pPrint . PP $ x) serverAppLog :: BinPkgName -> String serverAppLog x = serverLogDirectory x appLogBaseName serverAccessLog :: BinPkgName -> String serverAccessLog x = serverLogDirectory x accessLogBaseName appLogBaseName :: String appLogBaseName = "app.log" errorLogBaseName :: String errorLogBaseName = "error.log" accessLogBaseName :: String accessLogBaseName = "access.log" debianPackageVersion :: String -> IO (Maybe DebianVersion) debianPackageVersion name = readProcess "dpkg-query" ["--show", "--showformat=${version}", name] "" >>= return . parseDebianVersion' where -- This should maybe be the real parseDebianVersion parseDebianVersion' "" = Nothing parseDebianVersion' s = Just (parseDebianVersion s) -- | The version number of the installed debhelper package is the -- highest acceptable value for compat in a debian/control file. If -- the package doesn't explicitly set an (acceptable) compat value we -- can use the value returned by this function, assuming debhelper is -- installed. getDebhelperCompatLevel :: IO (Maybe Int) getDebhelperCompatLevel = debianPackageVersion "debhelper" >>= return . fmap (read . takeWhile (/= '.') . version) data StandardsVersion = StandardsVersion Int Int Int (Maybe Int) deriving (Eq, Ord, Show, Data, Typeable) instance Pretty (PP StandardsVersion) where pPrint (PP (StandardsVersion a b c (Just d))) = text (show a) <> text "." <> text (show b) <> text "." <> text (show c) <> text "." <> text (show d) pPrint (PP (StandardsVersion a b c Nothing)) = text (show a) <> text "." <> text (show b) <> text "." <> text (show c) -- | Assumes debian-policy is installed getDebianStandardsVersion :: IO (Maybe StandardsVersion) getDebianStandardsVersion = debianPackageVersion "debian-policy" >>= return . fmap (parseStandardsVersion . version) parseStandardsVersion :: String -> StandardsVersion parseStandardsVersion s = case filter (/= ".") (groupBy (\ a b -> (a == '.') == (b == '.')) s) of (a : b : c : d : _) -> StandardsVersion (read' (error . ("StandardsVersion" ++) . show) a) (read' (error . ("StandardsVersion" ++) . show) b) (read' (error . ("StandardsVersion" ++) . show) c) (Just (read' (error . ("StandardsVersion" ++) . show) d)) (a : b : c : _) -> StandardsVersion (read' (error . ("StandardsVersion" ++) . show) a) (read' (error . ("StandardsVersion" ++) . show) b) (read' (error . ("StandardsVersion" ++) . show) c) Nothing _ -> error $ "Invalid Standards-Version string: " ++ show s data SourceFormat = Native3 | Quilt3 deriving (Eq, Ord, Show, Data, Typeable) instance Pretty (PP SourceFormat) where pPrint (PP Quilt3) = text "3.0 (quilt)\n" pPrint (PP Native3) = text "3.0 (native)\n" readSourceFormat :: Text -> Either Text SourceFormat readSourceFormat s = case () of _ | strip s == "3.0 (native)" -> Right Native3 _ | strip s == "3.0 (quilt)" -> Right Quilt3 _ -> Left $ "Invalid debian/source/format: " <> pack (show (strip s)) data PackagePriority = Required | Important | Standard | Optional | Extra deriving (Eq, Ord, Read, Show, Data, Typeable) readPriority :: String -> PackagePriority readPriority s = case unpack (strip (pack s)) of "required" -> Required "important" -> Important "standard" -> Standard "optional" -> Optional "extra" -> Extra x -> error $ "Invalid priority string: " ++ show x instance Pretty (PP PackagePriority) where pPrint = text . map toLower . show . unPP -- | The architectures for which a binary deb can be built. data PackageArchitectures = All -- ^ The package is architecture independenct | Any -- ^ The package can be built for any architecture | Names [String] -- ^ The list of suitable architectures deriving (Read, Eq, Ord, Show, Data, Typeable) instance Pretty (PP PackageArchitectures) where pPrint (PP All) = text "all" pPrint (PP Any) = text "any" pPrint (PP (Names xs)) = text $ intercalate " " xs parsePackageArchitectures :: String -> PackageArchitectures parsePackageArchitectures "all" = All parsePackageArchitectures "any" = Any parsePackageArchitectures s = error $ "FIXME: parsePackageArchitectures " ++ show s data Section = MainSection String -- Equivalent to AreaSection Main s? | AreaSection Area String deriving (Read, Eq, Ord, Show, Data, Typeable) readSection :: String -> Section readSection s = case break (== '/') s of ("contrib", '/' : b) -> AreaSection Contrib (tail b) ("non-free", '/' : b) -> AreaSection NonFree (tail b) ("main", '/' : b) -> AreaSection Main (tail b) (a, '/' : _) -> error $ "readSection - unknown area: " ++ show a (a, _) -> MainSection a instance Pretty (PP Section) where pPrint (PP (MainSection sec)) = text sec pPrint (PP (AreaSection area sec)) = pPrint (PP area) <> text "/" <> text sec data MultiArch = MANo | MASame | MAForeign | MAAllowed deriving (Read, Eq, Ord, Show, Data, Typeable) readMultiArch :: String -> MultiArch readMultiArch s = case unpack (strip (pack s)) of "no" -> MANo "same" -> MASame "foreign" -> MAForeign "allowed" -> MAAllowed x -> error $ "Invalid Multi-Arch string: " ++ show x instance Pretty (PP MultiArch) where pPrint (PP MANo) = text "no" pPrint (PP MASame) = text "same" pPrint (PP MAForeign) = text "foreign" pPrint (PP MAAllowed) = text "allowed" -- Is this really all that is allowed here? Doesn't Ubuntu have different areas? data Area = Main | Contrib | NonFree deriving (Read, Eq, Ord, Show, Data, Typeable) instance Pretty (PP Area) where pPrint (PP Main) = text "main" pPrint (PP Contrib) = text "contrib" pPrint (PP NonFree) = text "non-free" {- Create a debian maintainer field from the environment variables: DEBFULLNAME (preferred) or NAME DEBEMAIL (preferred) or EMAIL More work could be done to match dch, but this is sufficient for now. Here is what the man page for dch has to say: If the environment variable DEBFULLNAME is set, this will be used for the maintainer full name; if not, then NAME will be checked. If the environment variable DEBEMAIL is set, this will be used for the email address. If this variable has the form "name ", then the maintainer name will also be taken from here if neither DEBFULLNAME nor NAME is set. If this variable is not set, the same test is performed on the environment variable EMAIL. Next, if the full name has still not been determined, then use getpwuid(3) to determine the name from the pass‐word file. If this fails, use the previous changelog entry. For the email address, if it has not been set from DEBEMAIL or EMAIL, then look in /etc/mailname, then attempt to build it from the username and FQDN, otherwise use the email address in the previous changelog entry. In other words, it’s a good idea to set DEBEMAIL and DEBFULLNAME when using this script. -} getCurrentDebianUser :: IO (Maybe NameAddr) getCurrentDebianUser = do env <- map (second decodeString) `fmap` getEnvironment return $ do fullname <- lookup "DEBFULLNAME" env `mplus` lookup "NAME" env email <- lookup "DEBEMAIL" env `mplus` lookup "EMAIL" env either (const Nothing) Just (parseMaintainer (fullname ++ " <" ++ email ++ ">")) haskellMaintainer :: NameAddr haskellMaintainer = NameAddr { nameAddr_name = Just "Debian Haskell Group" , nameAddr_addr = "pkg-haskell-maintainers@lists.alioth.debian.org"} -- | Turn the uploaders field of a cabal package into a list of -- RFC2822 NameAddr values. parseUploaders :: String -> Either String [NameAddr] parseUploaders x = either (Left . show) fixNameAddrs (parse address "" ("Names: " ++ map fixWhite x ++ ";")) -- either (\ e -> error ("Failure parsing uploader list: " ++ show x ++ " -> " ++ show e)) id $ where fixWhite c = if isSpace c then ' ' else c -- We absoletely need a name. fixNameAddrs :: [NameAddr] -> Either String [NameAddr] fixNameAddrs xs = case mapMaybe fixNameAddr xs of [] -> Left ("No valid debian maintainers in " ++ show x) xs' -> Right xs' fixNameAddr :: NameAddr -> Maybe NameAddr fixNameAddr y = case nameAddr_name y of Nothing -> Nothing _ -> Just y -- | Parse a string containing a single NameAddr value. parseMaintainer :: String -> Either String NameAddr parseMaintainer x = case parseUploaders x of Left s -> Left s Right [y] -> Right y Right [] -> Left $ "Missing maintainer: " ++ show x Right ys -> Left $ "Too many maintainers: " ++ show ys -- | Maintainer is a mandatory field, so we need a value we can use -- when all else fails. maintainerOfLastResort :: NameAddr Right maintainerOfLastResort = parseMaintainer "nobody " -- | Official Debian license types as described in -- . 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. | OtherLicense String -- ^ Any other license name deriving (Read, Show, Eq, Ord, Data, Typeable) -- We need a license parse function that converts these strings back -- into License values. instance Pretty License where pPrint Public_Domain = text "public-domain" pPrint Apache = text "Apache" pPrint Artistic = text "Artistic" pPrint BSD_2_Clause = text "BSD2" pPrint BSD_3_Clause = text "BSD3" pPrint BSD_4_Clause = text "BSD4" pPrint ISC = text "ISC" pPrint CC_BY = text "CC-BY" pPrint CC_BY_SA = text "CC-BY-SA" pPrint CC_BY_ND = text "CC-BY-ND" pPrint CC_BY_NC = text "CC-BY-NC" pPrint CC_BY_NC_SA = text "CC-BY-NC-SA" pPrint CC_BY_NC_ND = text "CC-BY-NC-ND" pPrint CC0 = text "CC0" pPrint CDDL = text "CDDL" pPrint CPL = text "CPL" pPrint EFL = text "EFL" pPrint Expat = text "Expat" pPrint GPL = text "GPL" pPrint LGPL = text "LGPL" pPrint GFDL = text "GFDL" pPrint GFDL_NIV = text "GFDL-NIV" pPrint LPPL = text "LPPL" pPrint MPL = text "MPL" pPrint Perl = text "Perl" pPrint Python = text "Python" pPrint QPL = text "QPL" pPrint W3C = text "W3C" pPrint Zlib = text "Zlib" pPrint Zope = text "Zope" pPrint (OtherLicense s) = text s -- | Convert the Cabal license to a Debian license. I would welcome input -- on how to make this more correct. fromCabalLicense :: Cabal.License -> License fromCabalLicense x = case x of 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 _ -> Apache Cabal.PublicDomain -> Public_Domain Cabal.AllRightsReserved -> OtherLicense "AllRightsReserved" Cabal.OtherLicense -> OtherLicense (show x) Cabal.UnknownLicense _ -> OtherLicense (show x) #if MIN_VERSION_Cabal(1,20,0) Cabal.MPL _ -> MPL #if MIN_VERSION_Cabal(1,22,0) Cabal.BSD2 -> BSD_2_Clause Cabal.ISC -> OtherLicense (show x) Cabal.UnspecifiedLicense -> OtherLicense (show x) #endif #endif -- | Convert a Debian license to a Cabal license. Additional cases -- and corrections welcome. toCabalLicense :: License -> Cabal.License toCabalLicense x = -- This needs to be finished case x of #if MIN_VERSION_Cabal(1,22,0) BSD_2_Clause -> Cabal.BSD2 #endif BSD_3_Clause -> Cabal.BSD3 BSD_4_Clause -> Cabal.BSD4 OtherLicense s -> Cabal.UnknownLicense s _ -> Cabal.UnknownLicense (show x) invalidLicense :: Text -> License invalidLicense = OtherLicense . unpack -- | I think we need an actual parser for license names. readLicense :: Text -> License readLicense t = let s = unpack (strip t) in fromMaybe (invalidLicense t) (readMaybe s) cabal-debian-4.31/src/Debian/GHC.hs0000644000000000000000000002153312565162075015034 0ustar0000000000000000{-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables, TemplateHaskell #-} {-# OPTIONS_GHC -Wall -fno-warn-orphans #-} module Debian.GHC ( withCompilerVersion , newestAvailable , compilerIdFromDebianVersion , compilerFlavorOption , newestAvailableCompilerId -- , ghcNewestAvailableVersion' -- , ghcNewestAvailableVersion -- , compilerIdFromDebianVersion , compilerPackageName #if MIN_VERSION_Cabal(1,22,0) , getCompilerInfo #endif ) where import Control.DeepSeq (force) import Control.Exception (SomeException, try) import Control.Monad (when) import Control.Monad.Trans (MonadIO, liftIO) import Data.Char ({-isSpace, toLower,-} toUpper) import Data.Function.Memoize (deriveMemoizable, memoize2) import Data.Maybe (fromMaybe) import Data.Version (showVersion, Version(Version), parseVersion) import Debian.Debianize.BinaryDebDescription (PackageType(..)) import Debian.Relation (BinPkgName(BinPkgName)) import Debian.Version (DebianVersion, parseDebianVersion) import Distribution.Compiler (CompilerFlavor(..), CompilerId(CompilerId)) #if MIN_VERSION_Cabal(1,22,0) import Distribution.Compiler (CompilerInfo(..), unknownCompilerInfo, AbiTag(NoAbiTag)) #endif import System.Console.GetOpt (ArgDescr(ReqArg), OptDescr(..)) import System.Directory (doesDirectoryExist) import System.Exit (ExitCode(ExitFailure)) import System.IO.Unsafe (unsafePerformIO) import System.Process (readProcess, showCommandForUser, readProcessWithExitCode) import System.Unix.Chroot (useEnv, fchroot) import System.Unix.Mount (WithProcAndSys) import Text.ParserCombinators.ReadP (readP_to_S) import Text.Read (readMaybe) $(deriveMemoizable ''CompilerFlavor) $(deriveMemoizable ''BinPkgName) withCompilerVersion :: FilePath -> CompilerFlavor -> (DebianVersion -> a) -> a withCompilerVersion root hc f = f (newestAvailableCompiler root hc) -- | Memoized version of newestAvailable' newestAvailable :: FilePath -> BinPkgName -> Maybe DebianVersion newestAvailable root pkg = memoize2 f pkg root where f :: BinPkgName -> FilePath -> Maybe DebianVersion f pkg' root' = unsafePerformIO (newestAvailable' root' pkg') -- | Look up the newest version of a deb available in the given changeroot. newestAvailable' :: FilePath -> BinPkgName -> IO (Maybe DebianVersion) newestAvailable' root (BinPkgName name) = do exists <- doesDirectoryExist root when (not exists) (error $ "newestAvailable: no such environment: " ++ show root) versions <- try $ chroot root $ (readProcess "apt-cache" ["showpkg", name] "" >>= return . dropWhile (/= "Versions: ") . lines) :: IO (Either SomeException [String]) case versions of Left e -> error $ "newestAvailable failed in " ++ show root ++ ": " ++ show e Right (_ : versionLine : _) -> return . Just . parseDebianVersion . takeWhile (/= ' ') $ versionLine _ -> return Nothing where chroot "/" = id chroot _ = useEnv root (return . force) newestAvailableCompiler :: FilePath -> CompilerFlavor -> DebianVersion newestAvailableCompiler root hc = fromMaybe (error $ "newestAvailableCompiler - No versions of " ++ show hc ++ " available in " ++ show root) (newestAvailable root (compilerPackageName hc Development)) newestAvailableCompilerId :: FilePath -> CompilerFlavor -> CompilerId newestAvailableCompilerId root hc = compilerIdFromDebianVersion hc (newestAvailableCompiler root hc) {- -- | The IO portion of ghcVersion. For there to be no version of ghc -- available is an exceptional condition, it has been standard in -- Debian and Ubuntu for a long time. ghcNewestAvailableVersion :: CompilerFlavor -> FilePath -> IO DebianVersion ghcNewestAvailableVersion hc root = do exists <- doesDirectoryExist root when (not exists) (error $ "ghcVersion: no such environment: " ++ show root) versions <- try $ chroot $ (readProcess "apt-cache" ["showpkg", map toLower (show hc)] "" >>= return . dropWhile (/= "Versions: ") . lines) :: IO (Either SomeException [String]) case versions of Left e -> error $ "ghcNewestAvailableVersion failed in " ++ show root ++ ": " ++ show e Right (_ : versionLine : _) -> return . parseDebianVersion . takeWhile (/= ' ') $ versionLine _ -> error $ "No version of ghc available in " ++ show root where chroot = case root of "/" -> id _ -> useEnv root (return . force) -- | Memoize the CompilerId built for the newest available version of -- the compiler package so we don't keep running apt-cache showpkg -- over and over. ghcNewestAvailableVersion' :: CompilerFlavor -> FilePath -> CompilerId ghcNewestAvailableVersion' hc root = memoize f (hc, root) where f :: (CompilerFlavor, FilePath) -> CompilerId f (hc', root) = unsafePerformIO (g hc' root) g hc root = do ver <- ghcNewestAvailableVersion hc root let cid = compilerIdFromDebianVersion ver -- hPutStrLn stderr ("GHC Debian version: " ++ show ver ++ ", Compiler ID: " ++ show cid) return cid -} compilerIdFromDebianVersion :: CompilerFlavor -> DebianVersion -> CompilerId compilerIdFromDebianVersion hc debVersion = let (Version ds ts) = greatestLowerBound debVersion (map (\ d -> Version [d] []) [0..]) in CompilerId hc (greatestLowerBound debVersion (map (\ d -> Version (ds ++ [d]) ts) [0..])) where greatestLowerBound :: DebianVersion -> [Version] -> Version greatestLowerBound b xs = last $ takeWhile (\ v -> parseDebianVersion (showVersion v) < b) xs -- | General function to build a command line option that reads most -- of the possible values for CompilerFlavor. compilerFlavorOption :: forall a. (CompilerFlavor -> a -> a) -> OptDescr (a -> a) compilerFlavorOption f = Option [] ["hc", "compiler-flavor"] (ReqArg readHC "COMPILER") "Build packages using this Haskell compiler" where -- Most of the constructors in CompilerFlavor are arity zero and -- all caps, though two are capitalized - Hugs and Helium. This -- won't read those, and it won't read HaskellSuite String or -- OtherCompiler String readHC :: String -> a -> a readHC s = maybe (error $ "Invalid CompilerFlavor: " ++ show s) f (readMaybe (map toUpper s)) {- debName :: CompilerFlavor -> Maybe BinPkgName debName hc = case map toLower (show hc) of s | any isSpace s -> Nothing s -> Just (BinPkgName s) -} compilerPackageName :: CompilerFlavor -> PackageType -> BinPkgName compilerPackageName GHC Documentation = BinPkgName "ghc-doc" -- "ghc-7.10.1-htmldocs" compilerPackageName GHC Profiling = BinPkgName "ghc-prof" -- "ghc-7.10.1-prof" compilerPackageName GHC Development = BinPkgName "ghc" -- "ghc-7.10.1" compilerPackageName GHC _ = BinPkgName "ghc" -- "ghc-7.10.1" -- whatevs #if MIN_VERSION_Cabal(1,22,0) compilerPackageName GHCJS Documentation = BinPkgName "ghcjs" compilerPackageName GHCJS Profiling = error "Profiling not supported for GHCJS" compilerPackageName GHCJS Development = BinPkgName "ghcjs" compilerPackageName GHCJS _ = BinPkgName "ghcjs" -- whatevs #endif compilerPackageName x _ = error $ "Unsupported compiler flavor: " ++ show x #if MIN_VERSION_Cabal(1,22,0) -- | IO based alternative to newestAvailableCompilerId - install the -- compiler into the chroot if necessary and ask it for its version -- number. This has the benefit of working for ghcjs, which doesn't -- make the base ghc version available in the version number. -- -- Assumes the compiler executable is already installed in the root -- environment. getCompilerInfo :: MonadIO m => FilePath -> CompilerFlavor -> WithProcAndSys m CompilerInfo getCompilerInfo "/" flavor = liftIO $ getCompilerInfo' flavor getCompilerInfo root flavor = liftIO $ fchroot root $ getCompilerInfo' flavor getCompilerInfo' :: CompilerFlavor -> IO CompilerInfo getCompilerInfo' flavor = do compilerId <- runVersionCommand >>= toCompilerId flavor compilerCompat <- case flavor of GHCJS -> readProcessWithExitCode "ghcjs" ["--numeric-ghc-version"] "" >>= toCompilerId GHC >>= return . Just . (: []) _ -> return Nothing return $ (unknownCompilerInfo compilerId NoAbiTag) {compilerInfoCompat = compilerCompat} where runVersionCommand :: IO (ExitCode, String, String) runVersionCommand = readProcessWithExitCode versionCommand ["--numeric-version"] "" versionCommand = case flavor of GHC -> "ghc"; GHCJS -> "ghcjs"; _ -> error $ "Flavor " ++ show flavor toCompilerId :: CompilerFlavor -> (ExitCode, String, String) -> IO CompilerId toCompilerId _ (ExitFailure n, _, err) = error $ showCommandForUser versionCommand ["--numeric-version"] ++ " -> " ++ show n ++ ", stderr: " ++ show err toCompilerId flavor' (_, out, _) = case filter ((== "\n") . snd) (readP_to_S parseVersion out) of [(v, _)] -> return $ CompilerId flavor' v _ -> error $ "Parse failure for version string: " ++ show out #endif cabal-debian-4.31/src/Debian/Orphans.hs0000644000000000000000000001131512565162075016042 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, OverloadedStrings, StandaloneDeriving, CPP #-} {-# OPTIONS_GHC -Wall -fno-warn-orphans #-} module Debian.Orphans where import Data.Function (on) import Data.Generics (Data, Typeable) import Data.List (intersperse, isPrefixOf) import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import Data.Version (showVersion, Version(..)) import Debian.Changes (ChangeLog(..), ChangeLogEntry(..)) import Debian.Pretty (PP(PP, unPP)) import Debian.Relation (ArchitectureReq(..), Relation(..), VersionReq(..)) import Distribution.Compiler (CompilerId(..)) #if MIN_VERSION_Cabal(1,22,0) import Distribution.Compiler (AbiTag(..)) #endif #if !MIN_VERSION_Cabal(1,18,0) import Distribution.Compiler (CompilerFlavor(..)) #endif import Distribution.License (License(..)) import Distribution.PackageDescription (Executable(..), PackageDescription(package)) import Distribution.Simple.Compiler (Compiler(..)) import Distribution.Version (foldVersionRange', VersionRange(..)) import Language.Haskell.Extension (Language(..)) #if !MIN_VERSION_Cabal(1,21,0) import Language.Haskell.Extension (Extension(..), KnownExtension(..)) #endif import Network.URI (URI) import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr(..)) import Text.PrettyPrint.HughesPJClass (hcat, Pretty(pPrint), text) deriving instance Typeable Compiler deriving instance Typeable CompilerId #if MIN_VERSION_Cabal(1,22,0) deriving instance Typeable AbiTag deriving instance Data AbiTag deriving instance Eq AbiTag deriving instance Ord AbiTag #endif deriving instance Data Compiler deriving instance Data CompilerId deriving instance Ord Language deriving instance Eq Compiler deriving instance Ord Compiler deriving instance Ord NameAddr deriving instance Ord License #if !MIN_VERSION_Cabal(1,21,1) deriving instance Ord KnownExtension deriving instance Ord Extension #endif instance Ord Executable where compare = compare `on` exeName instance Ord PackageDescription where compare = compare `on` package dropPrefix :: String -> String -> Maybe String dropPrefix p s = if isPrefixOf p s then Just (drop (length p) s) else Nothing deriving instance Data ArchitectureReq deriving instance Data ChangeLog deriving instance Data ChangeLogEntry deriving instance Data Relation deriving instance Data VersionReq deriving instance Typeable ArchitectureReq deriving instance Typeable ChangeLog deriving instance Typeable ChangeLogEntry deriving instance Typeable Relation deriving instance Typeable VersionReq deriving instance Ord ChangeLog deriving instance Ord ChangeLogEntry #if !MIN_VERSION_Cabal(1,18,0) deriving instance Data CompilerFlavor deriving instance Data Language deriving instance Data Version deriving instance Typeable CompilerFlavor deriving instance Typeable Extension deriving instance Typeable Language #endif -- Convert from license to RPM-friendly description. The strings are -- taken from TagsCheck.py in the rpmlint distribution. instance Pretty (PP License) where pPrint (PP (GPL _)) = text "GPL" pPrint (PP (LGPL _)) = text "LGPL" pPrint (PP BSD3) = text "BSD" pPrint (PP BSD4) = text "BSD-like" pPrint (PP PublicDomain) = text "Public Domain" pPrint (PP AllRightsReserved) = text "Proprietary" pPrint (PP OtherLicense) = text "Non-distributable" pPrint (PP MIT) = text "MIT" pPrint (PP (UnknownLicense _)) = text "Unknown" pPrint (PP x) = text (show x) deriving instance Data NameAddr deriving instance Typeable NameAddr deriving instance Read NameAddr -- This Pretty instance gives a string used to create a valid -- changelog entry, it *must* have a name followed by an email address -- in angle brackets. instance Pretty (PP NameAddr) where pPrint (PP x) = text (fromMaybe (nameAddr_addr x) (nameAddr_name x) ++ " <" ++ nameAddr_addr x ++ ">") -- pPrint x = text (maybe (nameAddr_addr x) (\ n -> n ++ " <" ++ nameAddr_addr x ++ ">") (nameAddr_name x)) instance Pretty (PP [NameAddr]) where pPrint = hcat . intersperse (text ", ") . map (pPrint . PP) . unPP instance Pretty (PP VersionRange) where pPrint (PP range) = foldVersionRange' (text "*") (\ v -> text "=" <> pPrint (PP v)) (\ v -> text ">" <> pPrint (PP v)) (\ v -> text "<" <> pPrint (PP v)) (\ v -> text ">=" <> pPrint (PP v)) (\ v -> text "<=" <> pPrint (PP v)) (\ x _ -> text "=" <> pPrint (PP x) <> text ".*") -- not exactly right (\ x y -> text "(" <> x <> text " || " <> y <> text ")") (\ x y -> text "(" <> x <> text " && " <> y <> text ")") (\ x -> text "(" <> x <> text ")") range instance Pretty (PP Version) where pPrint = text . showVersion . unPP instance Pretty (PP URI) where pPrint = text . show . unPP cabal-debian-4.31/src/Debian/Debianize/0000755000000000000000000000000012565162075015765 5ustar0000000000000000cabal-debian-4.31/src/Debian/Debianize/DebInfo.hs0000644000000000000000000004224012565162075017631 0ustar0000000000000000-- | This module holds a long list of lenses that access the Atoms -- record, the record that holds the input data from which the -- debianization is to be constructed. {-# LANGUAGE CPP, DeriveDataTypeable, Rank2Types, TemplateHaskell #-} {-# OPTIONS_GHC -Wall #-} module Debian.Debianize.DebInfo ( -- * Types #if __HADDOCK__ -- Is this ifdef working? DebInfo(..) #else DebInfo #endif , Atom(File, Install, InstallCabalExec, InstallCabalExecTo, InstallData, InstallDir, InstallTo, Link) , Site(Site, domain, server, serverAdmin) , Server(Server, headerMessage, hostname, installFile, port, retry, serverFlags) , InstallFile(InstallFile, destDir, destName, execName, sourceDir) , TestsStatus(..) -- * Lenses , flags , warning , sourceFormat , watch , rulesHead , rulesSettings , rulesIncludes , rulesFragments , copyright , control , intermediateFiles , compat , changelog , installInit , logrotateStanza , postInst , postRm , preInst , preRm , atomSet , noDocumentationLibrary , noProfilingLibrary , omitProfVersionDeps , omitLTDeps , buildDir , sourcePackageName , overrideDebianNameBase , revision , debVersion , maintainerOption , uploadersOption , utilsPackageNameBase , xDescriptionText , comments , missingDependencies , extraLibMap , execMap , apacheSite , sourceArchitectures , binaryArchitectures , sourcePriority , binaryPriorities , sourceSection , binarySections , executable , serverInfo , website , backups , extraDevDeps , official , testsStatus , allowDebianSelfBuildDeps , binaryDebDescription -- * Atom builders , link , install , installTo , installData , file , installCabalExec , installCabalExecTo , installDir -- * DebInfo Builder , makeDebInfo ) where import Control.Lens import Control.Monad.State (StateT) import Data.Generics (Data, Typeable) import Data.Map as Map (Map) import Data.Monoid (Monoid(..)) import Data.Set as Set (insert, Set) import Data.Text (Text) import Debian.Changes (ChangeLog) import Debian.Debianize.BasicInfo (Flags) import Debian.Debianize.Prelude (listElemLens, maybeLens) import Debian.Debianize.BinaryDebDescription (BinaryDebDescription, Canonical(canonical), newBinaryDebDescription, package) import Debian.Debianize.CopyrightDescription (CopyrightDescription) import qualified Debian.Debianize.SourceDebDescription as S (newSourceDebDescription, SourceDebDescription, binaryPackages) import Debian.Debianize.VersionSplits (DebBase) import Debian.Orphans () import Debian.Policy (PackageArchitectures, PackagePriority, Section, SourceFormat(..)) import Debian.Relation (BinPkgName, Relations, SrcPkgName) import Debian.Version (DebianVersion) import Prelude hiding (init, init, log, log) import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr) -- | Information required to represent a non-cabal debianization. data DebInfo = DebInfo { _flags :: Flags -- ^ Information regarding mode of operation - verbosity, dry-run, usage, etc , _warning :: Set Text -- ^ A warning to be reported later , _sourceFormat :: SourceFormat -- ^ Write debian/source/format , _watch :: Maybe Text -- ^ the @debian\/watch@ file , _rulesHead :: Maybe Text -- ^ The rules file header , _rulesSettings :: [Text] -- ^ The rules file assignments , _rulesIncludes :: [Text] -- ^ The rules file include directives , _rulesFragments :: Set Text -- ^ Additional fragments of the rules file , _copyright :: Maybe CopyrightDescription -- ^ Override the copyright value computed from the cabal package description. , _control :: S.SourceDebDescription -- ^ The parsed contents of the control file , _intermediateFiles :: Set (FilePath, Text) -- ^ Put this text into a file with the given name in the debianization. , _compat :: Maybe Int -- ^ The debhelper compatibility level, from debian/compat. , _changelog :: Maybe ChangeLog -- ^ The changelog, first entry contains the source package name and version , _installInit :: Map BinPkgName Text -- ^ Add an init.d file to the binary package , _logrotateStanza :: Map BinPkgName (Set Text) -- ^ Add a stanza of a logrotate file to the binary package , _postInst :: Map BinPkgName Text -- ^ Map of @debian/postinst@ scripts - to be run after install, -- should contain #DEBHELPER# line before exit 0 , _postRm :: Map BinPkgName Text -- ^ Map of @debian/postrm@ scripts - scripts to run after -- remove, should contain #DEBHELPER# line before exit 0 , _preInst :: Map BinPkgName Text -- ^ Map of @debian/preinst@ scripts - to be run before install, -- should contain #DEBHELPER# line before exit 0 , _preRm :: Map BinPkgName Text -- ^ Map of @debian/prerm@ scripts - to be run before remove, -- should contain #DEBHELPER# line before exit 0 , _atomSet :: Set Atom -- ^ set of items describing file installation requests , _noDocumentationLibrary :: Bool -- ^ Do not produce a libghc-foo-doc package. , _noProfilingLibrary :: Bool -- ^ Do not produce a libghc-foo-prof package. , _omitProfVersionDeps :: Bool -- ^ If present, Do not put the version dependencies on the prof packages that we put on the dev packages. , _omitLTDeps :: Bool -- ^ If present, don't generate the << dependency when we see a cabal -- equals dependency. (The implementation of this was somehow lost.) , _buildDir :: Maybe FilePath -- ^ The build directory used by cabal, typically dist/build when -- building manually or dist-ghc/build when building using GHC and -- haskell-devscripts. This value is used to locate files -- produced by cabal so we can move them into the deb. Note that -- the --builddir option of runhaskell Setup appends the "/build" -- to the value it receives, so, yes, try not to get confused. -- FIXME: make this FilePath or Maybe FilePath , _sourcePackageName :: Maybe SrcPkgName -- ^ Name to give to the debian source package. If not supplied -- the name is constructed from the cabal package name. Note that -- DebianNameMap could encode this information if we already knew -- the cabal package name, but we can't assume that. , _overrideDebianNameBase :: Maybe DebBase -- ^ If given, use this name for the base of the debian binary -- packages - the string between 'libghc-' and '-dev'. Normally -- this is derived from the hackage package name. , _revision :: Maybe String -- ^ Specify the revision string to use when converting the -- cabal version to debian. , _debVersion :: Maybe DebianVersion -- ^ Specify the exact debian version of the resulting package, -- including epoch. One use case is to work around the the -- "buildN" versions that are often uploaded to the debian and -- ubuntu repositories. Say the latest cabal version of -- transformers is 0.3.0.0, but the debian repository contains -- version 0.3.0.0-1build3, we need to specify -- debVersion="0.3.0.0-1build3" or the version we produce will -- look older than the one already available upstream. , _maintainerOption :: Maybe NameAddr , _uploadersOption :: [NameAddr] -- ^ Value for the maintainer field in the control file. Note that -- the cabal maintainer field can have multiple addresses, but debian -- only one. If this is not explicitly set, it is obtained from the -- cabal file, and if it is not there then from the environment. As a -- last resort, there is a hard coded string in here somewhere. , _utilsPackageNameBase :: Maybe String -- ^ Name of a package that will get left-over data files and executables. -- If there are more than one, each package will get those files. , _xDescriptionText :: Maybe Text -- ^ The text for the X-Description field of the Source package stanza. , _comments :: Maybe [[Text]] -- ^ Each element is a comment to be added to the changelog, where the -- element's text elements are the lines of the comment. , _missingDependencies :: Set BinPkgName -- ^ Lets cabal-debian know that a package it might expect to exist -- actually does not, so omit all uses in resulting debianization. , _extraLibMap :: Map String Relations -- ^ Map a cabal Extra-Library name to a debian binary package name, -- e.g. @ExtraLibMapping extraLibMap "cryptopp" "libcrypto-dev"@ adds a -- build dependency *and* a regular dependency on @libcrypto-dev@ to -- any package that has @cryptopp@ in its cabal Extra-Library list. , _execMap :: Map String Relations -- ^ Map a cabal Build-Tool name to a debian binary package name, -- e.g. @ExecMapping "trhsx" "haskell-hsx-utils"@ adds a build -- dependency on @haskell-hsx-utils@ to any package that has @trhsx@ in its -- cabal build-tool list. , _apacheSite :: Map BinPkgName (String, FilePath, Text) -- ^ Have Apache configure a site using PACKAGE, DOMAIN, LOGDIR, and APACHECONFIGFILE , _sourceArchitectures :: Maybe PackageArchitectures -- ^ Set the Architecture field of the source package , _binaryArchitectures :: Map BinPkgName PackageArchitectures -- ^ Set the Architecture field of a binary package , _sourcePriority :: Maybe PackagePriority -- ^ Set the Priority field of the source package , _binaryPriorities :: Map BinPkgName PackagePriority -- ^ Set the Priority field of a binary package , _sourceSection :: Maybe Section -- ^ Set the Section field of the source package , _binarySections :: Map BinPkgName Section -- ^ Set the Section field of a binary package , _executable :: Map BinPkgName InstallFile -- ^ Create a binary package to hold a cabal executable , _serverInfo :: Map BinPkgName Server -- ^ Like DHExecutable, but configure the executable as a server process , _website :: Map BinPkgName Site -- ^ Like DHServer, but configure the server as a web server , _backups :: Map BinPkgName String -- ^ Configure the executable to do incremental backups , _extraDevDeps :: Relations -- ^ Limited version of Depends, put a dependency on the dev library package. The only -- reason to use this is because we don't yet know the name of the dev library package. , _official :: Bool -- ^ Whether this packaging is created by the Debian Haskell Group , _testsStatus :: TestsStatus -- ^ Whether or not to build and/or run the test suite , _allowDebianSelfBuildDeps :: Bool -- ^ Normally self dependencies are filtered out of the debian -- build dependency list because they usually reflect -- interdependencies between the library and the executable in -- the Cabal packages. This flag turns off that filtering. } deriving (Show, Data, Typeable) data Atom = Link BinPkgName FilePath FilePath -- ^ Create a symbolic link in the binary package | Install BinPkgName FilePath FilePath -- ^ Install a build file into the binary package | InstallTo BinPkgName FilePath FilePath -- ^ Install a build file into the binary package at an exact location | InstallData BinPkgName FilePath FilePath -- ^ DHInstallTo somewhere relative to DataDir (see above) | File BinPkgName FilePath Text -- ^ Create a file with the given text at the given path | InstallCabalExec BinPkgName String FilePath -- ^ Install a cabal executable into the binary package | InstallCabalExecTo BinPkgName String FilePath -- ^ Install a cabal executable into the binary package at an exact location | InstallDir BinPkgName FilePath -- ^ Create a directory in the binary package deriving (Show, Eq, Ord, Data, Typeable) data InstallFile = InstallFile { execName :: String -- ^ The name of the executable file , sourceDir :: Maybe FilePath -- ^ where to find it, default is dist/build// , destDir :: Maybe FilePath -- ^ where to put it, default is usr/bin/ , destName :: String -- ^ name to give installed executable } deriving (Read, Show, Eq, Ord, Data, Typeable) -- | Information about the web site we are packaging. data Site = Site { domain :: String -- ^ The domain name assigned to the server. -- An apache configuration will be generated to -- redirect requests from this domain to hostname:port , serverAdmin :: String -- ^ Apache ServerAdmin parameter , server :: Server -- ^ The hint to install the server job } deriving (Read, Show, Eq, Ord, Data, Typeable) -- | Information about the server we are packaging. data Server = Server { hostname :: String -- ^ Host on which the server will run , port :: Int -- ^ Port on which the server will run. -- Obviously, this must assign each and -- every server package to a different -- port. , headerMessage :: String -- ^ A comment that will be inserted to -- explain how the file was generated , retry :: String -- ^ start-stop-daemon --retry argument , serverFlags :: [String] -- ^ Extra flags to pass to the server via the init script , installFile :: InstallFile -- ^ The hint to install the server executable } deriving (Read, Show, Eq, Ord, Data, Typeable) data TestsStatus = TestsDisable | TestsBuild | TestsRun deriving (Eq, Show, Data, Typeable) makeDebInfo :: Flags -> DebInfo makeDebInfo fs = DebInfo { _flags = fs , _warning = mempty , _sourceFormat = Quilt3 , _watch = Nothing , _rulesHead = Nothing , _rulesSettings = mempty , _rulesIncludes = mempty , _rulesFragments = mempty , _copyright = Nothing , _control = S.newSourceDebDescription , _intermediateFiles = mempty , _compat = Nothing , _changelog = Nothing , _installInit = mempty , _logrotateStanza = mempty , _postInst = mempty , _postRm = mempty , _preInst = mempty , _preRm = mempty , _atomSet = mempty , _noDocumentationLibrary = False , _noProfilingLibrary = False , _omitProfVersionDeps = False , _omitLTDeps = False , _buildDir = Nothing , _sourcePackageName = Nothing , _overrideDebianNameBase = Nothing , _revision = Nothing , _debVersion = Nothing , _maintainerOption = Nothing , _uploadersOption = [] , _utilsPackageNameBase = Nothing , _xDescriptionText = Nothing , _comments = Nothing , _missingDependencies = mempty , _extraLibMap = mempty , _execMap = mempty , _apacheSite = mempty , _sourceArchitectures = Nothing , _binaryArchitectures = mempty , _sourcePriority = Nothing , _binaryPriorities = mempty , _sourceSection = Nothing , _binarySections = mempty , _executable = mempty , _serverInfo = mempty , _website = mempty , _backups = mempty , _extraDevDeps = mempty , _official = False , _testsStatus = TestsRun , _allowDebianSelfBuildDeps = False } instance Canonical DebInfo where canonical x = x {_control = canonical (_control x)} $(makeLenses ''DebInfo) -- We need (%=_) link :: Monad m => BinPkgName -> FilePath -> FilePath -> StateT DebInfo m () link b src dest = atomSet %= (Set.insert $ Link b src dest) >> return () install :: Monad m => BinPkgName -> FilePath -> FilePath -> StateT DebInfo m () install b src dest = atomSet %= (Set.insert $ Install b src dest) >> return () installTo :: Monad m => BinPkgName -> FilePath -> FilePath -> StateT DebInfo m () installTo b src dest = atomSet %= (Set.insert $ InstallTo b src dest) >> return () installData :: Monad m => BinPkgName -> FilePath -> FilePath -> StateT DebInfo m () 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 () installCabalExec b name dest = atomSet %= (Set.insert $ InstallCabalExec b name dest) >> return () installCabalExecTo :: Monad m => BinPkgName -> String -> FilePath -> StateT DebInfo m () installCabalExecTo b name dest = atomSet %= (Set.insert $ InstallCabalExecTo b name dest) >> return () installDir :: Monad m => BinPkgName -> FilePath -> StateT DebInfo m () installDir b dir = atomSet %= (Set.insert $ InstallDir b dir) >> return () -- | Lens to look up the binary deb description by name and create it if absent. -- binaryDebDescription :: BinPkgName -> Lens' DebInfo BinaryDebDescription binaryDebDescription b = control . S.binaryPackages . listElemLens ((== b) . view package) . maybeLens (newBinaryDebDescription b) (iso id id) cabal-debian-4.31/src/Debian/Debianize/Goodies.hs0000644000000000000000000004420312565162075017715 0ustar0000000000000000-- | Things that seem like they could be clients of this library, but -- are instead included as part of the library. {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-unused-do-bind #-} module Debian.Debianize.Goodies ( tightDependencyFixup , doServer , doWebsite , doBackups , doExecutable , describe , watchAtom , oldClckwrksSiteFlags , oldClckwrksServerFlags , siteAtoms , serverAtoms , backupAtoms , execAtoms ) where import Control.Lens import Data.Char (isSpace) import Data.List as List (dropWhileEnd, intercalate, intersperse, map) import Data.Map as Map (insert, insertWith) import Data.Maybe (fromMaybe) import 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 qualified Debian.Debianize.CabalInfo as A import qualified Debian.Debianize.BinaryDebDescription as B import Debian.Orphans () import Debian.Policy (apacheAccessLog, apacheErrorLog, apacheLogDirectory, databaseDirectory, dataDirectory, serverAccessLog, serverAppLog) import Debian.Pretty (ppShow, ppText) import Debian.Relation (BinPkgName(BinPkgName), Relation(Rel)) import Distribution.Package (PackageName(PackageName)) import Distribution.PackageDescription as Cabal (PackageDescription(package, synopsis, description)) import Distribution.Simple.Build.PathsModule (pkgPathEnvVar) import Prelude hiding (init, log, map, unlines, writeFile) import System.FilePath (()) showCommand :: String -> [String] -> String showCommand cmd args = unwords (map translate (cmd : args)) translate :: String -> String translate str = '"' : foldr escape "\"" str where escape '"' = showString "\\\"" escape c = showChar c -- | Create equals dependencies. For each pair (A, B), use dpkg-query -- to find out B's version number, version B. Then write a rule into -- P's .substvar that makes P require that that exact version of A, -- and another that makes P conflict with any older version of A. tightDependencyFixup :: Monad m => [(BinPkgName, BinPkgName)] -> BinPkgName -> DebianT m () tightDependencyFixup [] _ = return () tightDependencyFixup pairs p = D.rulesFragments %= Set.insert (Text.unlines $ ([ "binary-fixup/" <> name <> "::" , "\techo -n 'haskell:Depends=' >> debian/" <> name <> ".substvars" ] ++ intersperse ("\techo -n ', ' >> debian/" <> name <> ".substvars") (List.map equals pairs) ++ [ "\techo '' >> debian/" <> name <> ".substvars" , "\techo -n 'haskell:Conflicts=' >> debian/" <> name <> ".substvars" ] ++ intersperse ("\techo -n ', ' >> debian/" <> name <> ".substvars") (List.map newer pairs) ++ [ "\techo '' >> debian/" <> name <> ".substvars" ])) where equals (installed, dependent) = "\tdpkg-query -W -f='" <> display' dependent <> " (=$${Version})' " <> display' installed <> " >> debian/" <> name <> ".substvars" newer (installed, dependent) = "\tdpkg-query -W -f='" <> display' dependent <> " (>>$${Version})' " <> display' installed <> " >> debian/" <> name <> ".substvars" name = display' p display' = ppText -- | 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) %= 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) %= 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) %= 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) %= 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 <- use A.packageDescription return $ debianDescriptionBase p {- <> "\n" <> case typ of Just B.Profiling -> Text.intercalate "\n" [" .", " This package provides a library for the Haskell programming language, compiled", " for profiling. See http:///www.haskell.org/ for more information on Haskell."] Just B.Development -> Text.intercalate "\n" [" .", " This package provides a library for the Haskell programming language.", " See http:///www.haskell.org/ for more information on Haskell."] Just B.Documentation -> Text.intercalate "\n" [" .", " This package provides the documentation for a library for the Haskell", " programming language.", " See http:///www.haskell.org/ for more information on Haskell." ] Just B.Exec -> Text.intercalate "\n" [" .", " An executable built from the " <> pack (display (pkgName (Cabal.package p))) <> " package."] {- ServerPackage -> Text.intercalate "\n" [" .", " A server built from the " <> pack (display (pkgName pkgId)) <> " package."] -} _ {-Utilities-} -> Text.intercalate "\n" [" .", " Files associated with the " <> pack (display (pkgName (Cabal.package p))) <> " package."] -- x -> error $ "Unexpected library package name suffix: " ++ show x -} -- | The Cabal package has one synopsis and one description field -- for the entire package, while in a Debian package there is a -- description field (of which the first line is synopsis) in -- each binary package. So the cabal description forms the base -- of the debian description, each of which is amended. debianDescriptionBase :: PackageDescription -> Text debianDescriptionBase p = pack $ List.intercalate "\n " $ (synop' : desc) where -- If we have a one line description and no synopsis, use -- the description as the synopsis. synop' = if null synop && length desc /= 1 then "WARNING: No synopsis available for package " ++ ppShow (package p) else synop synop :: String -- I don't know why (unwords . words) was applied here. Maybe I'll find out when -- this version goes into production. :-/ Ok, now I know, because sometimes the -- short cabal description has more than one line. synop = intercalate " " $ map (dropWhileEnd isSpace) $ lines $ Cabal.synopsis p desc :: [String] desc = List.map addDot . stripWith null $ map (dropWhileEnd isSpace) $ lines $ Cabal.description p addDot line = if null line then "." else line oldClckwrksSiteFlags :: D.Site -> [String] oldClckwrksSiteFlags x = [ -- According to the happstack-server documentation this needs a trailing slash. "--base-uri", "http://" ++ D.domain x ++ "/" , "--http-port", show D.port] oldClckwrksServerFlags :: D.Server -> [String] oldClckwrksServerFlags x = [ -- According to the happstack-server documentation this needs a trailing slash. "--base-uri", "http://" ++ D.hostname x ++ ":" ++ show (D.port x) ++ "/" , "--http-port", show D.port] watchAtom :: PackageName -> Text watchAtom (PackageName pkgname) = pack $ "version=3\nhttp://hackage.haskell.org/package/" ++ pkgname ++ "/distro-monitor .*-([0-9\\.]+)\\.(?:zip|tgz|tbz|txz|(?:tar\\.(?:gz|bz2|xz)))\n" siteAtoms :: PackageDescription -> BinPkgName -> D.Site -> CabalInfo -> CabalInfo siteAtoms pkgDesc b site = execCabalM (do (A.debInfo . D.atomSet) %= (Set.insert $ D.InstallDir b "/etc/apache2/sites-available") (A.debInfo . D.atomSet) %= (Set.insert $ D.Link b ("/etc/apache2/sites-available/" ++ D.domain site ++ ".conf") ("/etc/apache2/sites-enabled/" ++ D.domain site ++ ".conf")) (A.debInfo . D.atomSet) %= (Set.insert $ D.File b ("/etc/apache2/sites-available" D.domain site ++ ".conf") apacheConfig) (A.debInfo . D.atomSet) %= (Set.insert $ D.InstallDir b (apacheLogDirectory b)) (A.debInfo . D.logrotateStanza) %= Map.insertWith mappend b (singleton (Text.unlines $ [ pack (apacheAccessLog b) <> " {" , " copytruncate" -- hslogger doesn't notice when the log is rotated, maybe this will help , " weekly" , " rotate 5" , " compress" , " missingok" , "}"])) (A.debInfo . D.logrotateStanza) %= Map.insertWith mappend b (singleton (Text.unlines $ [ pack (apacheErrorLog b) <> " {" , " copytruncate" , " weekly" , " rotate 5" , " compress" , " missingok" , "}" ]))) . serverAtoms pkgDesc b (D.server site) True where -- An apache site configuration file. This is installed via a line -- in debianFiles. apacheConfig = Text.unlines $ [ "" , " ServerAdmin " <> pack (D.serverAdmin site) , " ServerName www." <> pack (D.domain site) , " ServerAlias " <> pack (D.domain site) , "" , " ErrorLog " <> pack (apacheErrorLog b) , " CustomLog " <> pack (apacheAccessLog b) <> " combined" , "" , " ProxyRequests Off" , " AllowEncodedSlashes NoDecode" , "" , " " , " AddDefaultCharset off" , " Order deny,allow" , " #Allow from .example.com" , " Deny from all" , " #Allow from all" , " " , "" , " port' <> "/*>" , " AddDefaultCharset off" , " Order deny,allow" , " #Allow from .example.com" , " #Deny from all" , " Allow from all" , " " , "" , " SetEnv proxy-sendcl 1" , "" , " ProxyPass / http://127.0.0.1:" <> port' <> "/ nocanon" , " ProxyPassReverse / http://127.0.0.1:" <> port' <> "/" , "" ] port' = pack (show (D.port (D.server site))) serverAtoms :: PackageDescription -> BinPkgName -> D.Server -> Bool -> CabalInfo -> CabalInfo serverAtoms pkgDesc b server' isSite = over (A.debInfo . D.postInst) (insertWith failOnMismatch b debianPostinst) . over (A.debInfo . D.installInit) (Map.insertWith failOnMismatch b debianInit) . serverLogrotate' b . execAtoms b exec where -- Combine two values (for insertWith) when there should only be -- one. If it happens twice with different values we should -- really find out why. failOnMismatch old new = if old /= new then error ("serverAtoms: " ++ show old ++ " -> " ++ show new) else old exec = D.installFile server' debianInit = Text.unlines $ [ "#! /bin/sh -e" , "" , ". /lib/lsb/init-functions" , "test -f /etc/default/" <> pack (D.destName exec) <> " && . /etc/default/" <> pack (D.destName exec) , "" , "case \"$1\" in" , " start)" , " test -x /usr/bin/" <> pack (D.destName exec) <> " || exit 0" , " log_begin_msg \"Starting " <> pack (D.destName exec) <> "...\"" , " mkdir -p " <> pack (databaseDirectory b) , " export " <> pack (pkgPathEnvVar pkgDesc "datadir") <> "=" <> pack (dataDirectory pkgDesc) , " " <> startCommand , " log_end_msg $?" , " ;;" , " stop)" , " log_begin_msg \"Stopping " <> pack (D.destName exec) <> "...\"" , " " <> stopCommand , " log_end_msg $?" , " ;;" , " *)" , " log_success_msg \"Usage: ${0} {start|stop}\"" , " exit 1" , "esac" , "" , "exit 0" ] startCommand = pack $ showCommand "start-stop-daemon" (startOptions ++ commonOptions ++ ["--"] ++ D.serverFlags server') stopCommand = pack $ showCommand "start-stop-daemon" (stopOptions ++ commonOptions) commonOptions = ["--pidfile", "/var/run/" ++ D.destName exec] startOptions = ["--start", "-b", "--make-pidfile", "-d", databaseDirectory b, "--exec", "/usr/bin" D.destName exec] stopOptions = ["--stop", "--oknodo"] ++ if D.retry server' /= "" then ["--retry=" ++ D.retry server' ] else [] debianPostinst = Text.unlines $ ([ "#!/bin/sh" , "" , "case \"$1\" in" , " configure)" ] ++ (if isSite then [ " # Apache won't start if this directory doesn't exist" , " mkdir -p " <> pack (apacheLogDirectory b) , " # Restart apache so it sees the new file in /etc/apache2/sites-enabled" , " /usr/sbin/a2enmod proxy" , " /usr/sbin/a2enmod proxy_http" , " service apache2 restart" ] else []) ++ [ -- This gets done by the #DEBHELPER# code below. {- " service " <> pack (show (pPrint b)) <> " start", -} " ;;" , "esac" , "" , "#DEBHELPER#" , "" , "exit 0" ]) -- | A configuration file for the logrotate facility, installed via a line -- in debianFiles. serverLogrotate' :: BinPkgName -> CabalInfo -> CabalInfo serverLogrotate' b = over (A.debInfo . D.logrotateStanza) (insertWith Set.union b (singleton (Text.unlines $ [ pack (serverAccessLog b) <> " {" , " weekly" , " rotate 5" , " compress" , " missingok" , "}" ]))) . over (A.debInfo . D.logrotateStanza) (insertWith Set.union b (singleton (Text.unlines $ [ pack (serverAppLog b) <> " {" , " weekly" , " rotate 5" , " compress" , " missingok" , "}" ]))) backupAtoms :: BinPkgName -> String -> CabalInfo -> CabalInfo backupAtoms b name = 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" , "" , "case \"$1\" in" , " configure)" , " " <> pack ("/etc/cron.hourly" name) <> " --initialize" , " ;;" , "esac" ])) . execAtoms b (D.InstallFile { D.execName = name , D.destName = name , D.sourceDir = Nothing , D.destDir = Just "/etc/cron.hourly" }) execAtoms :: BinPkgName -> D.InstallFile -> CabalInfo -> CabalInfo execAtoms b ifile r = over (A.debInfo . D.rulesFragments) (Set.insert (pack ("build" ppShow b ++ ":: build-ghc-stamp\n"))) . fileAtoms b ifile $ r fileAtoms :: BinPkgName -> D.InstallFile -> CabalInfo -> CabalInfo fileAtoms b installFile' r = fileAtoms' b (D.sourceDir installFile') (D.execName installFile') (D.destDir installFile') (D.destName installFile') r fileAtoms' :: BinPkgName -> Maybe FilePath -> String -> Maybe FilePath -> String -> CabalInfo -> CabalInfo fileAtoms' b sourceDir' execName' destDir' destName' r = case (sourceDir', execName' == destName') of (Nothing, True) -> execCabalM ((A.debInfo . D.atomSet) %= (Set.insert $ D.InstallCabalExec b execName' d)) r (Just s, True) -> execCabalM ((A.debInfo . D.atomSet) %= (Set.insert $ D.Install b (s execName') d)) r (Nothing, False) -> execCabalM ((A.debInfo . D.atomSet) %= (Set.insert $ D.InstallCabalExecTo b execName' (d destName'))) r (Just s, False) -> execCabalM ((A.debInfo . D.atomSet) %= (Set.insert $ D.InstallTo b (s execName') (d destName'))) r where d = fromMaybe "usr/bin" destDir' cabal-debian-4.31/src/Debian/Debianize/Changelog.hs0000644000000000000000000000224012565162075020206 0ustar0000000000000000module Debian.Debianize.Changelog ( filterEntries , dropFutureEntries , findChangelogEntry , mergeChangelogEntries ) where import Debian.Changes (ChangeLog(..), ChangeLogEntry(..)) import Debian.Version (DebianVersion) import Prelude hiding (log) -- | Apply a filter to the version numbers of the changelog entries. filterEntries :: (DebianVersion -> Bool) -> ChangeLog -> ChangeLog filterEntries p (ChangeLog entries) = ChangeLog $ filter (p . logVersion) $ entries -- | Filter out versions newer than the given one. dropFutureEntries :: DebianVersion -> ChangeLog -> ChangeLog dropFutureEntries ver log = filterEntries (<= ver) log -- | Find the log entry with the given version. findChangelogEntry :: DebianVersion -> ChangeLog -> Maybe ChangeLogEntry findChangelogEntry ver log = case filterEntries (== ver) log of ChangeLog [] -> Nothing ChangeLog [x] -> Just x _ -> error $ "Multiple version " ++ show ver ++ " changelog entries" mergeChangelogEntries :: ChangeLogEntry -> ChangeLogEntry -> ChangeLogEntry mergeChangelogEntries old new = old { logComments = logComments old ++ logComments new , logDate = logDate new } cabal-debian-4.31/src/Debian/Debianize/Prelude.hs0000644000000000000000000003164612565162075017733 0ustar0000000000000000-- | Functions and instances used by but not related to cabal-debian. -- These could conceivably be moved into more general libraries. {-# LANGUAGE FlexibleContexts, FlexibleInstances, Rank2Types, ScopedTypeVariables #-} {-# OPTIONS_GHC -Wall -fno-warn-orphans #-} module Debian.Debianize.Prelude ( curry3 , DebMap , buildDebVersionMap , (!) , strip , stripWith , strictReadF , replaceFile , modifyFile , diffFile , removeIfExists , dpkgFileMap , debOfFile , cond , readFile' , readFileMaybe , showDeps , showDeps' , withCurrentDirectory , getDirectoryContents' , setMapMaybe , zipMaps , foldEmpty , maybeL , indent , maybeRead , read' , modifyM , intToVerbosity' , listElemLens , maybeLens , fromEmpty , fromSingleton , (.?=) , escapeDebianWildcards ) where import Control.Applicative ((<$>)) 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, 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, lookup, map, Map) import Data.Maybe (catMaybes, fromJust, fromMaybe, listToMaybe, mapMaybe) import Data.Monoid ((<>), mconcat) import Data.Set as Set (Set, toList) 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) import Debian.Orphans () import Debian.Pretty (PP(PP)) import qualified Debian.Relation as D (BinPkgName(BinPkgName), Relations) import Debian.Relation.Common () import Debian.Version (DebianVersion, prettyDebianVersion) import Debian.Version.String (parseDebianVersion) 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 System.Directory (doesDirectoryExist, doesFileExist, getCurrentDirectory, getDirectoryContents, removeDirectory, removeFile, renameFile, setCurrentDirectory) import System.FilePath ((), dropExtension) import System.IO (hSetBinaryMode, IOMode(ReadMode), openFile, withFile) import System.IO.Error (catchIOError, isDoesNotExistError) import System.Process (readProcessWithExitCode, showCommandForUser) import Text.PrettyPrint.HughesPJClass as PP (Pretty(pPrint), text) curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d curry3 f a b c = f (a, b, c) type DebMap = Map D.BinPkgName (Maybe DebianVersion) -- | Read and parse the status file for installed debian packages: @/var/lib/dpkg/status@ buildDebVersionMap :: IO DebMap buildDebVersionMap = readFile "/var/lib/dpkg/status" >>= return . either (const []) unControl . parseControl "/var/lib/dpkg/status" >>= mapM (\ p -> case (lookupP "Package" p, lookupP "Version" p) of (Just (Field (_, name)), Just (Field (_, version))) -> return (Just (D.BinPkgName (stripWS name), Just (parseDebianVersion (stripWS version)))) _ -> return Nothing) >>= return . Map.fromList . catMaybes (!) :: DebMap -> D.BinPkgName -> DebianVersion m ! k = maybe (error ("No version number for " ++ (show . pPrint . PP $ k) ++ " in " ++ show (Map.map (maybe Nothing (Just . prettyDebianVersion)) m))) id (Map.findWithDefault Nothing k m) strip :: String -> String strip = stripWith isSpace stripWith :: (a -> Bool) -> [a] -> [a] stripWith f = dropWhile f . dropWhileEnd f strictReadF :: (Text -> r) -> FilePath -> IO r strictReadF f path = withFile path ReadMode (\h -> hGetContents h >>= (\x -> return $! f x)) -- strictRead = strictReadF id -- | Write a file which we might still be reading from in -- order to compute the text argument. replaceFile :: FilePath -> String -> IO () replaceFile path s = do removeFile back `E.catch` (\ (e :: IOException) -> when (not (isDoesNotExistError e)) (ioError e)) renameFile path back `E.catch` (\ (e :: IOException) -> when (not (isDoesNotExistError e)) (ioError e)) writeFile path s where back = path ++ "~" -- | Compute the new file contents from the old. If f returns Nothing -- do not write. modifyFile :: FilePath -> (String -> IO (Maybe String)) -> IO () modifyFile path f = do removeFile back `E.catch` (\ (e :: IOException) -> when (not (isDoesNotExistError e)) (ioError e)) try (renameFile path back) >>= either (\ (e :: IOException) -> if not (isDoesNotExistError e) then ioError e else f "" >>= maybe (return ()) (writeFile path)) (\ () -> readFile back >>= f >>= maybe (return ()) (writeFile path)) where back = path ++ "~" diffFile :: FilePath -> Text -> IO (Maybe String) diffFile path s = readProcessWithExitCode cmd args (unpack s) >>= \ (code, out, _err) -> case code of ExitSuccess -> return Nothing ExitFailure 1 -> return (Just out) _ -> error (showCommandForUser cmd args {- ++ " < " ++ show s -} ++ " -> " ++ show code) where cmd = "diff" args = ["-ruw", path, "-"] removeFileIfExists :: FilePath -> IO () removeFileIfExists x = doesFileExist x >>= (`when` (removeFile x)) removeDirectoryIfExists :: FilePath -> IO () removeDirectoryIfExists x = doesDirectoryExist x >>= (`when` (removeDirectory x)) removeIfExists :: FilePath -> IO () removeIfExists x = removeFileIfExists x >> removeDirectoryIfExists x -- |Create a map from pathname to the names of the packages that contains that pathname using the -- contents of the debian package info directory @/var/lib/dpkg/info@. dpkgFileMap :: IO (Map FilePath (Set D.BinPkgName)) dpkgFileMap = do let fp = "/var/lib/dpkg/info" names <- getDirectoryContents fp >>= return . filter (isSuffixOf ".list") let paths = List.map (fp ) names -- Read strictly to make sure we consume all the files and don't -- hold tons of open file descriptors. files <- mapM (strictReadF Text.lines) paths return $ Map.fromList $ zip (List.map dropExtension names) (List.map (Set.fromList . List.map (D.BinPkgName . unpack)) $ files) -- |Given a path, return the name of the package that owns it. debOfFile :: FilePath -> ReaderT (Map FilePath (Set D.BinPkgName)) IO (Maybe D.BinPkgName) debOfFile path = do mp <- ask return $ testPath (lookup path mp) where -- testPath :: Maybe (Set FilePath) -> Maybe FilePath testPath Nothing = Nothing testPath (Just s) = case Set.size s of 1 -> Just (Set.findMin s) _ -> Nothing cond :: t -> t -> Bool -> t cond ifF _ifT False = ifF cond _ifF ifT True = ifT readFile' :: FilePath -> IO Text readFile' path = do file <- openFile path ReadMode hSetBinaryMode file True hGetContents file readFileMaybe :: FilePath -> IO (Maybe Text) readFileMaybe path = (Just <$> readFile' path) `catchIOError` (\ _ -> return Nothing) showDeps :: D.Relations -> String showDeps = show . pPrint . PP showDeps' :: D.Relations -> String showDeps' xss = show $ mconcat $ intersperse (text "\n ") $ [pPrint (PP xs) <> text "," | xs <- xss ] -- | From Darcs.Utils - set the working directory and run an IO operation. withCurrentDirectory :: FilePath -> IO a -> IO a withCurrentDirectory path m = E.bracket (do oldwd <- getCurrentDirectory let newwd = oldwd path setCurrentDirectory' newwd return oldwd) (\oldwd -> setCurrentDirectory' oldwd {- `catchall` return () -}) (\_oldwd -> m) setCurrentDirectory' :: FilePath -> IO () setCurrentDirectory' dir = try (setCurrentDirectory dir) >>= either handle return where handle e@(IOError {ioe_type = NoSuchThing}) = throw $ e {ioe_description = ioe_description e ++ ": " ++ show dir} handle e@(IOError {ioe_type = InappropriateType}) = throw $ e {ioe_description = ioe_description e ++ ": " ++ show dir} handle e@(IOError {ioe_type = typ}) = throw $ e {ioe_description = ioe_description e ++ " unexpected ioe_type: " ++ show typ} {- catchall :: IO a -> IO a -> IO a a `catchall` b = a `catchNonSignal` (\_ -> b) -- catchNonSignal is a drop-in replacement for Control.Exception.catch, which allows -- us to catch anything but a signal. Useful for situations where we want -- don't want to inhibit ctrl-C. catchNonSignal :: IO a -> (E.SomeException -> IO a) -> IO a catchNonSignal comp handler = catch comp handler' where handler' se = case fromException se :: Maybe SignalException of Nothing -> handler se Just _ -> E.throw se newtype SignalException = SignalException Signal deriving (Show, Typeable) instance Exception SignalException where toException e = SomeException e fromException (SomeException e) = cast e -} -- | Get directory contents minus dot files. getDirectoryContents' :: FilePath -> IO [FilePath] getDirectoryContents' dir = getDirectoryContents dir >>= return . filter (not . dotFile) where dotFile "." = True dotFile ".." = True dotFile _ = False setMapMaybe :: (Ord a, Ord b) => (a -> Maybe b) -> Set a -> Set b setMapMaybe p = Set.fromList . mapMaybe p . toList zipMaps :: Ord k => (k -> Maybe a -> Maybe b -> Maybe c) -> Map k a -> Map k b -> Map k c zipMaps f m n = foldWithKey h (foldWithKey g Map.empty m) n where g k a r = case f k (Just a) (lookup k n) of Just c -> Map.insert k c r -- Both m and n have entries for k Nothing -> r -- Only m has an entry for k h k b r = case lookup k m of Nothing -> case f k Nothing (Just b) of Just c -> Map.insert k c r -- Only n has an entry for k Nothing -> r Just _ -> r foldEmpty :: r -> ([a] -> r) -> [a] -> r foldEmpty r _ [] = r foldEmpty _ f l = f l -- | 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)) maybeRead :: Read a => String -> Maybe a maybeRead = fmap fst . listToMaybe . reads read' :: Read a => (String -> a) -> String -> a read' f s = fromMaybe (f s) (maybeRead s) -- modifyM :: (Monad m, MonadTrans t, MonadState a (t m)) => (a -> m a) -> t m () -- modifyM f = get >>= lift . f >>= put -- modifyM :: (Monad m, MonadTrans t, MonadState a (t m)) => (a -> m a) -> t m () modifyM :: MonadState a m => (a -> m a) -> m () modifyM f = get >>= f >>= put -- read' :: Read a => String -> a -- read' s = trace ("read " ++ show s) (read s) -- | Version of 'Distribution.Verbosity.intToVerbosity' that first -- clamps its argument to the acceptable range (0-3). intToVerbosity' :: Int -> Verbosity intToVerbosity' n = fromJust (intToVerbosity (max 0 (min 3 n))) listElemLens :: (a -> Bool) -> Lens' [a] (Maybe a) listElemLens p = lens lensGet lensPut where lensGet xs = case span (not . p) xs of (_, x : _) -> Just x _ -> Nothing lensPut xs Nothing = case span (not . p) xs of (before, _ : after) -> before ++ after _ -> xs lensPut xs (Just x) = case span (not . p) xs of (before, _ : after) -> before ++ (x : after) _ -> xs ++ [x] maybeLens :: a -> Lens' a b -> Lens' (Maybe a) b maybeLens def l = 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 fromEmpty _ s = s fromSingleton :: a -> ([a] -> a) -> Set a -> a fromSingleton e multiple s = case toList s of [x] -> x [] -> e xs -> multiple xs instance Pretty (PP PackageIdentifier) where pPrint (PP p) = pPrint (PP (pkgName p)) <> text "-" <> pPrint (PP (pkgVersion p)) 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 -- | This should probably be used in a lot of places. escapeDebianWildcards :: String -> String escapeDebianWildcards (c : more) | elem c "[]" = '\\' : c : escapeDebianWildcards more escapeDebianWildcards (c : more) = c : escapeDebianWildcards more escapeDebianWildcards "" = "" cabal-debian-4.31/src/Debian/Debianize/Interspersed.hs0000644000000000000000000000500612565162075020771 0ustar0000000000000000-- | A class used while converting Cabal dependencies into Debian -- dependencies. {-# LANGUAGE FlexibleInstances, FunctionalDependencies, MultiParamTypeClasses, StandaloneDeriving, TypeSynonymInstances #-} {-# OPTIONS_GHC -Wall -Werror #-} module Debian.Debianize.Interspersed ( Interspersed(..) ) where import Debug.Trace (trace) -- | A class of Bs insterspersed with Cs. It is used when converting -- the cabal dependencies to debian, where the "around" type is the -- binary package name and the "between" type is the version number. -- -- Minimum implementation is a method to return the leftmost B, and -- another to return the following (C,B) pairs. Its unfortunate to -- require lists in the implementation, a fold function would be -- better (though I find implementing such folds to be a pain in the -- you-know-what.) -- -- The class provides implementations of three folds, each of which -- exposes slightly different views of the data. class Interspersed t around between | t -> around, t -> between where leftmost :: t -> around pairs :: t -> [(between, around)] foldTriples :: (around -> between -> around -> r -> r) -> r -> t -> r foldTriples f r0 x = snd $ foldl (\ (b1, r) (c, b2) -> (b1, f b1 c b2 r)) (leftmost x, r0) (pairs x) -- Treat the b's as the centers and the c's as the things to their -- left and right. Use Maybe to make up for the missing c's at the -- ends. foldInverted :: (Maybe between -> around -> Maybe between -> r -> r) -> r -> t -> r foldInverted f r0 x = (\ (bn, an, r) -> f bn an Nothing r) $ foldl g (Nothing, leftmost x, r0) (pairs x) where g (b1, a1, r) (b2, a2) = (Just b2, a2, f b1 a1 (Just b2) r) foldArounds :: (around -> around -> r -> r) -> r -> t -> r foldArounds f r0 x = snd $ foldl (\ (a1, r) (_, a2) -> (a2, f a1 a2 r)) (leftmost x, r0) (pairs x) foldBetweens :: (between -> r -> r) -> r -> t -> r foldBetweens f r0 x = foldl (\ r (b, _) -> (f b r)) r0 (pairs x) -- | An example data Splits = Splits Double [(String, Double)] deriving Show instance Interspersed Splits Double String where leftmost (Splits x _) = x pairs (Splits _ x) = x _splits :: Splits _splits = Splits 1.0 [("between 1 and 2", 2.0), ("between 2 and 3", 3.0)] _test1 :: () _test1 = foldTriples (\ l s r () -> trace ("l=" ++ show l ++ " s=" ++ show s ++ " r=" ++ show r) ()) () _splits _test2 :: () _test2 = foldInverted (\ sl f sr () -> trace ("sl=" ++ show sl ++ " f=" ++ show f ++ " sr=" ++ show sr) ()) () _splits cabal-debian-4.31/src/Debian/Debianize/Monad.hs0000644000000000000000000000410712565162075017361 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wall #-} module Debian.Debianize.Monad ( CabalInfo , CabalT , runCabalT , evalCabalT , execCabalT , CabalM , runCabalM , evalCabalM , execCabalM -- * modify cabal to debian package version map -- , mapCabal -- , splitCabal , DebianT , evalDebianT , evalDebian , execDebianT , liftCabal , ifM , whenM , unlessM ) where 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) import Debian.Orphans () import Prelude hiding (init, log, unlines) type CabalT m = StateT CabalInfo m -- Better name - CabalT? type CabalM = State CabalInfo execCabalT :: Monad m => CabalT m a -> CabalInfo -> m CabalInfo execCabalT action atoms = execStateT action atoms evalCabalT :: Monad m => CabalT m a -> CabalInfo -> m a evalCabalT action atoms = evalStateT action atoms runCabalT :: Monad m => CabalT m a -> CabalInfo -> m (a, CabalInfo) runCabalT action atoms = runStateT action atoms execCabalM :: CabalM a -> CabalInfo -> CabalInfo execCabalM action atoms = execState action atoms evalCabalM :: CabalM a -> CabalInfo -> a evalCabalM action atoms = evalState action atoms runCabalM :: CabalM a -> CabalInfo -> (a, CabalInfo) runCabalM action atoms = runState action atoms type DebianT m = StateT DebInfo m evalDebianT :: Monad m => DebianT m a -> DebInfo -> m a evalDebianT = evalStateT evalDebian :: DebianT Identity a -> DebInfo -> a evalDebian = evalState execDebianT :: Monad m => DebianT m () -> DebInfo -> m DebInfo execDebianT = execStateT liftCabal :: Monad m => StateT DebInfo m a -> StateT CabalInfo m a 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 whenM :: Monad m => m Bool -> m () -> m () whenM m r = m >>= \ b -> if b then r else return () unlessM :: Monad m => m Bool -> m () -> m () unlessM m r = m >>= \ b -> if b then return () else r cabal-debian-4.31/src/Debian/Debianize/DebianName.hs0000644000000000000000000001330412565162075020305 0ustar0000000000000000-- | How to name the debian packages based on the cabal package name and version number. {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeFamilies #-} {-# OPTIONS -Wall -Wwarn -fno-warn-name-shadowing -fno-warn-orphans #-} module Debian.Debianize.DebianName ( debianName , debianNameBase , mkPkgName , mkPkgName' , mapCabal , splitCabal , remapCabal ) where import Control.Applicative ((<$>)) 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.CabalInfo as A (debianNameMap, packageDescription, debInfo) import Debian.Debianize.BinaryDebDescription as Debian (PackageType(..)) import Debian.Debianize.DebInfo as D (overrideDebianNameBase, utilsPackageNameBase) import Debian.Debianize.VersionSplits (DebBase(DebBase, unDebBase), doSplits, insertSplit, makePackage, VersionSplits) import Debian.Orphans () import Debian.Relation (PkgName(..), Relations) import qualified Debian.Relation as D (VersionReq(EEQ)) import Debian.Version (parseDebianVersion) import Distribution.Compiler (CompilerFlavor(..)) import Distribution.Package (Dependency(..), PackageIdentifier(..), PackageName(PackageName)) import qualified Distribution.PackageDescription as Cabal (PackageDescription(package)) import Prelude hiding (unlines) data Dependency_ = BuildDepends Dependency | BuildTools Dependency | PkgConfigDepends Dependency | ExtraLibs Relations deriving (Eq, Show) -- | Build the Debian package name for a given package type. debianName :: (Monad m, Functor m, PkgName name) => PackageType -> CompilerFlavor -> CabalT m name debianName typ cfl = do base <- case (typ, cfl) of (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) -- | Function that applies the mapping from cabal names to debian -- names based on version numbers. If a version split happens at v, -- this will return the ltName if < v, and the geName if the relation -- is >= v. debianNameBase :: Monad m => CabalT m DebBase debianNameBase = do nameBase <- use (debInfo . D.overrideDebianNameBase) pkgDesc <- use packageDescription let pkgId = Cabal.package pkgDesc 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 (Just base, _) -> return base (Nothing, Nothing) -> return $ debianBaseName pname (Nothing, Just splits) -> return $ doSplits splits version -- | Build a debian package name from a cabal package name and a -- debian package type. Unfortunately, this does not enforce the -- correspondence between the PackageType value and the name type, so -- it can return nonsense like (SrcPkgName "libghc-debian-dev"). mkPkgName :: PkgName name => CompilerFlavor -> PackageName -> PackageType -> name mkPkgName cfl pkg typ = mkPkgName' cfl typ (debianBaseName pkg) mkPkgName' :: PkgName name => CompilerFlavor -> PackageType -> DebBase -> name mkPkgName' cfl typ (DebBase base) = pkgNameFromString $ case typ of Documentation -> prefix ++ base ++ "-doc" Development -> prefix ++ base ++ "-dev" Profiling -> prefix ++ base ++ "-prof" Utilities -> base {- ++ case cfl of GHC -> "" _ -> "-" ++ map toLower (show cfl) -} Exec -> base Source -> base HaskellSource -> "haskell-" ++ base Cabal -> base where prefix = "lib" ++ map toLower (show cfl) ++ "-" debianBaseName :: PackageName -> DebBase debianBaseName (PackageName name) = DebBase (map (fixChar . toLower) name) where -- Underscore is prohibited in debian package names. fixChar :: Char -> Char fixChar '_' = '-' fixChar c = toLower c -- | Map all versions of Cabal package pname to Debian package dname. -- Not really a debian package name, but the name of a cabal package -- that maps to the debian package name we want. (Should this be a -- SrcPkgName?) mapCabal :: Monad m => PackageName -> DebBase -> CabalT m () mapCabal pname dname = debianNameMap %= Map.alter f pname where f :: Maybe VersionSplits -> Maybe VersionSplits f Nothing = Just (makePackage dname) f (Just sp) = error $ "mapCabal " ++ show pname ++ " " ++ show dname ++ ": - already mapped: " ++ show sp -- | Map versions less than ver of Cabal Package pname to Debian package ltname splitCabal :: Monad m => PackageName -> DebBase -> Version -> CabalT m () splitCabal pname ltname ver = debianNameMap %= Map.alter f pname where f :: Maybe VersionSplits -> Maybe VersionSplits f Nothing = error $ "splitCabal - not mapped: " ++ show pname f (Just sp) = Just (insertSplit ver ltname sp) -- | Replace any existing mapping of the cabal name 'pname' with the -- debian name 'dname'. (Use case: to change the debian package name -- so it differs from the package provided by ghc.) remapCabal :: Monad m => PackageName -> DebBase -> CabalT m () remapCabal pname dname = do debianNameMap %= Map.alter (const Nothing) pname mapCabal pname dname cabal-debian-4.31/src/Debian/Debianize/BinaryDebDescription.hs0000644000000000000000000001174012565162075022367 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, TemplateHaskell #-} {-# OPTIONS -Wall #-} module Debian.Debianize.BinaryDebDescription ( Canonical(canonical) , BinaryDebDescription , newBinaryDebDescription , package , multiArch , description , packageType , architecture , binarySection , binaryPriority , essential , relations , PackageType(..) , PackageRelations , newPackageRelations , depends , recommends , suggests , preDepends , breaks , conflicts , provides , replaces , builtUsing ) where import Data.Function (on) import Data.Generics (Data, Typeable) import Control.Lens.TH (makeLenses) import Data.List (sort, sortBy) import Data.Monoid (Monoid(..)) import Data.Text (Text) import Debian.Policy (PackageArchitectures, PackagePriority, Section, MultiArch) import Debian.Relation (BinPkgName, Relations) import Prelude hiding ((.)) class Canonical a where canonical :: a -> a -- | This type represents a section of the control file other than the -- first, which in turn represent one of the binary packages or debs -- produced by this debianization. data BinaryDebDescription = BinaryDebDescription { _package :: BinPkgName -- ^ , _packageType :: Maybe PackageType , _architecture :: Maybe PackageArchitectures -- ^ , _binarySection :: Maybe Section , _binaryPriority :: Maybe PackagePriority , _multiArch :: Maybe MultiArch , _essential :: Maybe Bool -- ^ , _description :: Maybe Text -- ^ , _relations :: PackageRelations -- ^ } deriving (Eq, Ord, Read, Show, Data, Typeable) -- ^ The different types of binary debs we can produce from a haskell package data PackageType = Development -- ^ The libghc-foo-dev package. | Profiling -- ^ The libghc-foo-prof package. | Documentation -- ^ The libghc-foo-doc package. | Exec -- ^ A package related to a particular executable, perhaps -- but not necessarily a server. | Utilities -- ^ A package that holds the package's data files -- and any executables not assigned to other -- packages. | Source -- ^ The source package (not a binary deb actually.) | HaskellSource -- ^ The source package of a haskell library (add -- prefix haskell- to source package name.) | Cabal -- ^ This is used to construct the value for -- DEB_CABAL_PACKAGE in the rules file deriving (Eq, Ord, Show, Read, Data, Typeable) -- ^ Package interrelationship information. data PackageRelations = PackageRelations { _depends :: Relations , _recommends :: Relations , _suggests :: Relations , _preDepends :: Relations , _breaks :: Relations , _conflicts :: Relations , _provides :: Relations , _replaces :: Relations , _builtUsing :: Relations } deriving (Eq, Ord, Read, Show, Data, Typeable) instance Canonical [BinaryDebDescription] where canonical xs = sortBy (compare `on` _package) (map canonical xs) instance Canonical BinaryDebDescription where canonical x = x {_relations = canonical (_relations x)} instance Canonical PackageRelations where canonical x = x { _depends = canonical (_depends x) , _recommends = canonical (_recommends x) , _suggests = canonical (_suggests x) , _preDepends = canonical (_preDepends x) , _breaks = canonical (_breaks x) , _conflicts = canonical (_conflicts x) , _provides = canonical (_provides x) , _replaces = canonical (_replaces x) , _builtUsing = canonical (_builtUsing x) } instance Canonical Relations where canonical xss = sort xss newBinaryDebDescription :: BinPkgName -> BinaryDebDescription newBinaryDebDescription name = BinaryDebDescription { _package = name , _packageType = Nothing , _architecture = Nothing , _multiArch = Nothing , _binarySection = Nothing , _binaryPriority = Nothing , _essential = Nothing , _description = mempty , _relations = newPackageRelations } newPackageRelations :: PackageRelations newPackageRelations = PackageRelations { _depends = [] , _recommends = [] , _suggests = [] , _preDepends = [] , _breaks = [] , _conflicts = [] , _provides = [] , _replaces = [] , _builtUsing = [] } $(makeLenses ''BinaryDebDescription) $(makeLenses ''PackageRelations) cabal-debian-4.31/src/Debian/Debianize/Details.hs0000644000000000000000000000412612565162075017711 0ustar0000000000000000-- | Detailed information about the specific repositories such as -- debian or seereason - in particular how cabal names are mapped to -- debian. {-# OPTIONS -Wall #-} module Debian.Debianize.Details ( debianDefaults ) where 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.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)) -- | Update the CabalInfo value in the CabalT state with some details about -- the debian repository - special cases for how some cabal packages -- are mapped to debian package names. debianDefaults :: Monad m => CabalT m () debianDefaults = do -- These are the two epoch names I know about in the debian repo A.epochMap %= Map.insert (PackageName "HaXml") 1 A.epochMap %= Map.insert (PackageName "HTTP") 1 -- Associate some build tools and their corresponding -- (eponymous) debian package names mapM (\name -> (A.debInfo . D.execMap) %= Map.insert name [[Rel (BinPkgName name) Nothing Nothing]]) ["ghc", "happy", "alex", "hsx2hs"] -- The parsec debs are suffixed with either "2" or "3" mapCabal (PackageName "parsec") (DebBase "parsec3") -- Similar split for quickcheck mapCabal (PackageName "QuickCheck") (DebBase "quickcheck2") -- Something was required for this package at one time - it -- looks like a no-op now mapCabal (PackageName "gtk2hs-buildtools") (DebBase "gtk2hs-buildtools") -- Upgrade transformers to 0.4 - no don't! -- remapCabal (PackageName "transformers") (DebBase "transformers4") -- remapCabal (PackageName "haskeline") (DebBase "haskeline0713") mapCabal (PackageName "haskell-src-exts") (DebBase "src-exts") mapCabal (PackageName "haskell-src-meta") (DebBase "src-meta") cabal-debian-4.31/src/Debian/Debianize/Bundled.hs0000644000000000000000000001347112565162075017704 0ustar0000000000000000-- | Determine whether a specific version of a Haskell package is -- bundled with into this particular version of the given compiler. {-# LANGUAGE FlexibleContexts, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell #-} module Debian.Debianize.Bundled ( builtIn -- * Utilities , aptCacheShowPkg , aptCacheProvides , aptCacheDepends , aptCacheConflicts , aptVersions ) where import Control.DeepSeq (force) import Control.Exception (SomeException, try) import Data.Char (toLower) import Data.Function (on) import Data.Function.Memoize (memoize2, memoize3) import Data.List (isPrefixOf, sortBy) import Data.Map as Map (Map) import Data.Maybe (listToMaybe, mapMaybe) import Data.Version (parseVersion, Version(..)) import Debian.Debianize.VersionSplits (cabalFromDebian', DebBase(DebBase), VersionSplits) import Debian.GHC () import Debian.Relation (BinPkgName(..)) import Debian.Relation.ByteString () import Debian.Version (DebianVersion, parseDebianVersion, prettyDebianVersion) import Distribution.Package (PackageIdentifier(..), PackageName(..)) import Distribution.Simple.Compiler (CompilerFlavor(..)) import System.IO.Unsafe (unsafePerformIO) import System.Process (readProcess) import System.Unix.Chroot (useEnv) import Text.ParserCombinators.ReadP (readP_to_S) import Text.Regex.TDFA ((=~)) -- | Find out what version, if any, of a cabal library is built into -- the newest version of haskell compiler hc in environment root. For -- GHC this is done by looking at what virtual packages debian package -- provides. I have modified the ghcjs packaging to generate the -- required virtual packages in the Provides line. For other -- compilers it maybe be unimplemented. builtIn :: Map PackageName VersionSplits -> CompilerFlavor -> FilePath -> PackageName -> Maybe Version builtIn splits hc root lib = do f $ builtIn' splits hc root where f :: (DebianVersion, [PackageIdentifier]) -> Maybe Version f (hcv, ids) = case map pkgVersion (filter (\ i -> pkgName i == lib) ids) of [] -> Nothing [v] -> Just v vs -> error $ show hc ++ "-" ++ show hcv ++ " in " ++ show root ++ " provides multiple versions of " ++ show lib ++ ": " ++ show vs -- | Ok, lets see if we can infer the built in packages from the -- Provides field returned by apt-cache. builtIn' :: Map PackageName VersionSplits -> CompilerFlavor -> FilePath -> (DebianVersion, [PackageIdentifier]) builtIn' splits hc root = do -- Find out what library versions are provided by the latest version -- of the compiler. case aptCacheProvides root hcname of [] -> error $ "No versions of " ++ show hc ++ " (" ++ show hcname ++ ") in " ++ show root ((v, pids) : _) -> (v, mapMaybe (parsePackageID . unBinPkgName) pids) where BinPkgName hcname = BinPkgName (map toLower (show hc)) -- The virtual package id, which appears in the Provides -- line for the compiler package, is generated by the -- function package_id_to_virtual_package in Dh_Haskell.sh. -- It consists of the library's debian package name and the -- first five characters of the checksum. -- parsePID "libghc-unix-dev-2.7.0.1-2a456" -> Just (PackageIdentifier "unix" (Version [2,7,0,1] [])) parsePackageID :: String -> Maybe PackageIdentifier parsePackageID s = case s =~ ("lib" ++ hcname ++ "-(.*)-dev-([0-9.]*)-.....$") :: (String, String, String, [String]) of (_, _, _, [base, vs]) -> case listToMaybe (map fst $ filter ((== "") . snd) $ readP_to_S parseVersion $ vs) of Just v -> Just (cabalFromDebian' splits (DebBase base) v) Nothing -> Nothing _ -> Nothing aptCacheShowPkg :: FilePath -> String -> Either SomeException String aptCacheShowPkg = memoize2 (\ root hcname -> unsafePerformIO (try (chroot root (readProcess "apt-cache" ["showpkg", hcname] "")))) where chroot "/" = id chroot root = useEnv root (return . force) aptCacheProvides :: FilePath -> String -> [(DebianVersion, [BinPkgName])] aptCacheProvides root hcname = let lns = lines . either (\ (e :: SomeException) -> error $ "builtIn: " ++ show e) id $ aptCacheShowPkg root hcname hcs = map words $ takeBetween (isPrefixOf "Provides:") (isPrefixOf "Reverse Provides:") lns hcs' = reverse . sortBy (compare `on` fst) . map doHCVersion $ hcs in hcs' where doHCVersion :: [String] -> (DebianVersion, [BinPkgName]) doHCVersion (versionString : "-" : deps) = (parseDebianVersion versionString, map BinPkgName deps) doHCVersion x = error $ "Unexpected output from apt-cache: " ++ show x aptCacheDepends :: FilePath -> String -> String -> Either SomeException String aptCacheDepends = memoize3 (\ root hcname ver -> unsafePerformIO (try (chroot root (readProcess "apt-cache" ["depends", hcname ++ "=" ++ ver] "")))) where chroot "/" = id chroot root = useEnv root (return . force) aptCacheConflicts :: FilePath -> String -> DebianVersion -> [BinPkgName] aptCacheConflicts root hcname ver = either (\ _ -> []) (mapMaybe doLine . lines) (aptCacheDepends root hcname (show (prettyDebianVersion ver))) where doLine s = case s =~ "^[ ]*Conflicts:[ ]*<(.*)>$" :: (String, String, String, [String]) of (_, _, _, [name]) -> Just (BinPkgName name) _ -> Nothing aptVersions :: FilePath -> String -> [DebianVersion] aptVersions root hcname = either (\ _ -> []) (map parseDebianVersion . filter (/= "") . map (takeWhile (/= ' ')) . takeWhile (not . isPrefixOf "Reverse Depends:") . drop 1 . dropWhile (not . isPrefixOf "Versions:") . lines) (aptCacheShowPkg root hcname) takeBetween :: (a -> Bool) -> (a -> Bool) -> [a] -> [a] takeBetween startPred endPred = takeWhile (not . endPred) . dropWhile startPred . dropWhile (not . startPred) cabal-debian-4.31/src/Debian/Debianize/Output.hs0000644000000000000000000002161512565162075017626 0ustar0000000000000000-- | Wrappers around the debianization function to perform various -- tasks - output, describe, validate a debianization, run an external -- script to produce a debianization. {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE FlexibleInstances, OverloadedStrings, ScopedTypeVariables, StandaloneDeriving, TupleSections, TypeSynonymInstances, RankNTypes #-} {-# OPTIONS -Wall -fno-warn-name-shadowing -fno-warn-orphans #-} module Debian.Debianize.Output ( finishDebianization , runDebianizeScript , writeDebianization , describeDebianization , compareDebianization , validateDebianization , performDebianization ) where import Control.Exception as E (throw) import Control.Lens import Control.Monad.State (get, put, StateT) import Control.Monad.Trans (liftIO, MonadIO) import Data.Algorithm.DiffContext (getContextDiff, prettyContextDiff) import Data.Map as Map (elems, toList) import Data.Maybe (fromMaybe) import Data.Text as Text (split, Text, unpack) import Debian.Debianize.CabalInfo (newCabalInfo) import Debian.Changes (ChangeLog(..), ChangeLogEntry(..)) import Debian.Debianize.BasicInfo (dryRun, validate, upgrade, roundtrip) import Debian.Debianize.CabalInfo (CabalInfo, debInfo) import qualified Debian.Debianize.DebInfo as D import Debian.Debianize.Files (debianizationFileMap) import Debian.Debianize.InputDebian (inputDebianization) import Debian.Debianize.Monad (DebianT, CabalT, evalDebian, evalCabalT) import Debian.Debianize.Prelude (indent, replaceFile, zipMaps) import Debian.Debianize.Finalize (debianize) import Debian.Debianize.Optparse 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 System.Directory (createDirectoryIfMissing, doesFileExist, getCurrentDirectory, getPermissions, Permissions(executable), setPermissions) import System.Exit (ExitCode(ExitSuccess)) import System.FilePath ((), takeDirectory) import System.IO (hPutStrLn, stderr) import System.Process (readProcessWithExitCode, showCommandForUser) import Text.PrettyPrint.HughesPJClass (text) import System.Posix.Env (setEnv) -- | Run the script in @debian/Debianize.hs@ with the given command -- line arguments. Returns @True@ if the script exists and succeeds. -- In this case it may be assumed that a debianization was created (or -- updated) in the debian subdirectory of the current directory. In -- this way we can include a script in a package to produce a -- customized debianization more sophisticated than the one that would -- be produced by the cabal-debian executable. An example is included -- in the debian subdirectory of this library. runDebianizeScript :: [String] -> IO Bool runDebianizeScript args = getCurrentDirectory >>= \here -> doesFileExist "debian/Debianize.hs" >>= \ exists -> case exists of False -> return False True -> do -- By default runhaskell looks for source in ., we will also look -- in src. Better would be to see where the cabal file looks. let args' = ["-i.:src", "debian/Debianize.hs"] ++ args hPutStrLn stderr ("running external debianization script in " ++ show here ++ ":\n " ++ showCommandForUser "runhaskell" args') result <- readProcessWithExitCode "runhaskell" args' "" case result of (ExitSuccess, _, _) -> return True (code, out, err) -> error (" external debianization script failed:\n " ++ showCommandForUser "runhaskell" args' ++ " -> " ++ show code ++ "\n stdout: " ++ show out ++"\n stderr: " ++ show err) -- | Perform whole debianization. You provide your customization, -- this function does everything else. performDebianization :: CabalT IO () -> IO () performDebianization custom = parseProgramArguments >>= \CommandLineOptions {..} -> newCabalInfo _flags >>= (evalCabalT $ do handleBehaviorAdjustment _adjustment debianize custom finishDebianization) -- | Depending on the options in @atoms@, either validate, describe, -- or write the generated debianization. finishDebianization :: forall m. (MonadIO m, Functor m) => StateT CabalInfo m () finishDebianization = zoom debInfo $ do new <- get case () of _ | view (D.flags . validate) new -> do inputDebianization old <- get return $ validateDebianization old new _ | view (D.flags . dryRun) new -> do inputDebianization old <- get let diff = compareDebianization old new liftIO $ putStrLn ("Debianization (dry run):\n" ++ if null diff then " No changes\n" else show diff) _ | view (D.flags . upgrade) new -> do inputDebianization old <- get let merged = mergeDebianization old new put merged writeDebianization _ | view (D.flags . roundtrip) new -> do inputDebianization writeDebianization _ -> writeDebianization -- | Write the files of the debianization @d@ to ./debian writeDebianization :: (MonadIO m, Functor m) => DebianT m () writeDebianization = do files <- debianizationFileMap liftIO $ mapM_ (uncurry doFile) (Map.toList files) liftIO $ getPermissions "debian/rules" >>= setPermissions "debian/rules" . (\ p -> p {executable = True}) where doFile path text = do createDirectoryIfMissing True (takeDirectory path) replaceFile path (unpack text) -- | Return a string describing the debianization - a list of file -- names and their contents in a somewhat human readable format. describeDebianization :: (MonadIO m, Functor m) => DebianT m String describeDebianization = debianizationFileMap >>= return . concatMap (\ (path, text) -> path ++ ": " ++ indent " > " (unpack text)) . Map.toList -- | Do only the usual maintenance changes when upgrading to a new version -- and avoid changing anything that is usually manually maintained. mergeDebianization :: D.DebInfo -> D.DebInfo -> D.DebInfo mergeDebianization old new = override (D.control . S.buildDepends) . override (D.control . S.buildDependsIndep) . override (D.control . S.homepage) . override (D.control . S.vcsFields) $ old where override :: forall b. Lens' D.DebInfo b -> (D.DebInfo -> D.DebInfo) override lens = set lens (new ^. lens) -- | Compare the old and new debianizations, returning a string -- describing the differences. compareDebianization :: D.DebInfo -> D.DebInfo -> [String] compareDebianization old new = let oldFiles = evalDebian debianizationFileMap (canonical old) newFiles = evalDebian debianizationFileMap (canonical new) in elems $ zipMaps doFile oldFiles newFiles where doFile :: FilePath -> Maybe Text -> Maybe Text -> Maybe String doFile path (Just _) Nothing = Just (path ++ ": Deleted\n") doFile path Nothing (Just n) = Just (path ++ ": Created\n" ++ indent " | " (unpack n)) doFile path (Just o) (Just n) = if o == n then Nothing -- Just (path ++ ": Unchanged\n") else Just (show (prettyContextDiff (text ("old" path)) (text ("new" path)) (text . unpack) (getContextDiff 2 (split (== '\n') o) (split (== '\n') n)))) doFile _path Nothing Nothing = error "Internal error in zipMaps" -- | Make sure the new debianization matches the existing -- debianization in several ways - specifically, version number, and -- the names of the source and binary packages. Some debian packages -- come with a skeleton debianization that needs to be filled in, this -- can be used to make sure the debianization we produce is usable. validateDebianization :: D.DebInfo -> D.DebInfo -> () validateDebianization old new = case () of _ | oldVersion /= newVersion -> throw (userError ("Version mismatch, expected " ++ ppShow oldVersion ++ ", found " ++ ppShow newVersion)) | oldSource /= newSource -> throw (userError ("Source mismatch, expected " ++ ppShow oldSource ++ ", found " ++ ppShow newSource)) | 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") (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 cabal-debian-4.31/src/Debian/Debianize/VersionSplits.hs0000644000000000000000000001451012565162075021146 0ustar0000000000000000-- | Convert between cabal and debian package names based on version -- number ranges. {-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} module Debian.Debianize.VersionSplits ( DebBase(DebBase, unDebBase) -- * Combinators for VersionSplits , VersionSplits , makePackage , insertSplit -- * Operators on VersionSplits , cabalFromDebian , cabalFromDebian' , debianFromCabal , packageRangesFromVersionSplits , doSplits ) where import Data.Generics (Data, Typeable) import Data.Map as Map (elems, Map, mapMaybeWithKey) import Data.Set as Set (fromList, Set, toList) import Data.Version (showVersion, Version(Version)) import Debian.Debianize.Interspersed (foldTriples, Interspersed(leftmost, pairs, foldInverted)) import Debian.Orphans () import qualified Debian.Relation as D (VersionReq(..)) import Debian.Version (DebianVersion, parseDebianVersion) import Distribution.Package (PackageIdentifier(..), PackageName(..)) import Distribution.Version (anyVersion, earlierVersion, intersectVersionRanges, orLaterVersion, VersionRange) import Prelude hiding (init, log, unlines) -- | The base of a debian binary package name, the string that appears -- between "libghc-" and "-dev". newtype DebBase = DebBase {unDebBase :: String} deriving (Eq, Ord, Read, Show, Data, Typeable) -- | Describes a mapping from cabal package name and version to debian -- package names. For example, versions of the cabal QuickCheck -- package less than 2 are mapped to "quickcheck1", while version 2 or -- greater is mapped to "quickcheck2". data VersionSplits = VersionSplits { oldestPackage :: DebBase -- ^ The Debian name given to versions older than the oldest split. , splits :: [(Version, DebBase)] -- ^ Each pair is The version where the split occurs, and the -- name to use for versions greater than or equal to that -- version. This list assumed to be in (must be kept in) -- ascending version number order. } deriving (Eq, Ord, Data, Typeable) instance Show VersionSplits where show s = foldr (\ (v, b) r -> ("insertSplit (" ++ show v ++ ") (" ++ show b ++ ") (" ++ r ++ ")")) ("makePackage (" ++ show (oldestPackage s) ++ ")") (splits s) instance Interspersed VersionSplits DebBase Version where leftmost (VersionSplits {oldestPackage = p}) = p pairs (VersionSplits {splits = xs}) = xs -- | Create a version split database that assigns a single debian -- package name base to all cabal versions. makePackage :: DebBase -> VersionSplits makePackage name = VersionSplits {oldestPackage = name, splits = []} -- | Split the version range and give the older packages a new name. insertSplit :: Version -> DebBase -> VersionSplits -> VersionSplits insertSplit ver@(Version _ _) ltname sp@(VersionSplits {}) = -- (\ x -> trace ("insertSplit " ++ show (ltname, ver, sp) ++ " -> " ++ show x) x) $ case splits sp of -- This is the oldest split, change oldestPackage and insert a new head pair (ver', _) : _ | ver' > ver -> sp {oldestPackage = ltname, splits = (ver, oldestPackage sp) : splits sp} [] -> sp {oldestPackage = ltname, splits = [(ver, oldestPackage sp)]} -- Not the oldest split, insert it in its proper place. _ -> sp {splits = reverse (insert (reverse (splits sp)))} where -- Insert our new split into the reversed list insert ((ver', name') : more) = if ver' < ver then (ver, name') : (ver', ltname) : more else (ver', name') : insert more -- ver' is older, change oldestPackage insert [] = [(ver, oldestPackage sp)] -- ltname = base ++ "-" ++ (show (last ns - 1)) packageRangesFromVersionSplits :: VersionSplits -> [(DebBase, VersionRange)] packageRangesFromVersionSplits s = foldInverted (\ older dname newer more -> (dname, intersectVersionRanges (maybe anyVersion orLaterVersion older) (maybe anyVersion earlierVersion newer)) : more) [] s debianFromCabal :: VersionSplits -> PackageIdentifier -> DebBase debianFromCabal s p = doSplits s (Just (D.EEQ debVer)) where debVer = parseDebianVersion (showVersion (pkgVersion p)) cabalFromDebian' :: Map PackageName VersionSplits -> DebBase -> Version -> PackageIdentifier cabalFromDebian' mp base ver = PackageIdentifier (cabalFromDebian mp base dver) ver where dver = parseDebianVersion (showVersion ver) -- | Brute force implementation - I'm assuming this is not a huge map. cabalFromDebian :: Map PackageName VersionSplits -> DebBase -> DebianVersion -> PackageName cabalFromDebian mp base@(DebBase name) ver = case Set.toList pset of [x] -> x [] -> PackageName name l -> error $ "Error, multiple cabal package names associated with " ++ show base ++ ": " ++ show l where -- Look for splits that involve the right DebBase and return the -- associated Cabal package name. It is unlikely that more than -- one Cabal name will be returned - if so throw an exception. pset :: Set PackageName pset = Set.fromList $ Map.elems $ Map.mapMaybeWithKey (\ p s -> if doSplits s (Just (D.EEQ ver)) == base then Just p else Nothing) mp -- | Given a version split database, turn the debian version -- requirements into a debian package name base that ought to satisfy -- them. doSplits :: VersionSplits -> Maybe D.VersionReq -> DebBase doSplits s version = foldTriples' (\ ltName v geName _ -> let split = parseDebianVersion (showVersion v) in case version of Nothing -> geName Just (D.SLT v') | v' <= split -> ltName -- Otherwise use ltName only when the split is below v' Just (D.EEQ v') | v' < split -> ltName Just (D.LTE v') | v' < split -> ltName Just (D.GRE v') | v' < split -> ltName Just (D.SGR v') | v' < split -> ltName _ -> geName) (oldestPackage s) s where foldTriples' :: (DebBase -> Version -> DebBase -> DebBase -> DebBase) -> DebBase -> VersionSplits -> DebBase foldTriples' = foldTriples cabal-debian-4.31/src/Debian/Debianize/InputDebian.hs0000644000000000000000000004324312565162075020531 0ustar0000000000000000-- | Read an existing Debianization from a directory file. {-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances, ScopedTypeVariables, TypeSynonymInstances #-} {-# OPTIONS_GHC -Wall -fno-warn-orphans #-} module Debian.Debianize.InputDebian ( inputDebianization , inputDebianizationFile , inputChangeLog , dataDest , dataTop ) where 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 ((<>), 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) import Debian.Changes (parseChangeLog) import Debian.Control (Control'(unControl), ControlFunctions, Field, Field'(..), Paragraph'(..), parseControlFromFile, stripWS) import Debian.Debianize.DebInfo (changelog, compat, control, copyright, install, installDir, installInit, intermediateFiles, link, logrotateStanza, postInst, postRm, preInst, preRm, rulesHead, sourceFormat, warning, watch) import qualified Debian.Debianize.DebInfo as T (flags, makeDebInfo) import Debian.Debianize.Monad (CabalT, DebianT) import Debian.Debianize.CabalInfo (packageDescription) import Debian.Debianize.BinaryDebDescription (BinaryDebDescription, newBinaryDebDescription) import qualified Debian.Debianize.BinaryDebDescription as B (architecture, binaryPriority, multiArch, 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, xDescription, 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, readMultiArch, readSourceFormat, Section(..)) import Debian.Relation (BinPkgName(..), parseRelations, Relations, SrcPkgName(..)) import Debug.Trace (trace) import Distribution.Package (PackageIdentifier(..), PackageName(..)) import qualified Distribution.PackageDescription as Cabal (dataDir, PackageDescription(package)) import Prelude hiding (break, lines, log, null, readFile, sum, words) import System.Directory (doesFileExist) import System.FilePath ((), dropExtension, takeExtension) import System.IO.Error (catchIOError, tryIOError) -- import System.Unix.Chroot (useEnv) -- import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr) inputDebianization :: MonadIO m => DebianT m () inputDebianization = do -- Erase any the existing information fs <- use T.flags put $ T.makeDebInfo fs (ctl, _) <- inputSourceDebDescription inputCabalInfoFromDirectory control .= ctl -- | Try to input a file and if successful add it to the -- debianization's list of "intermediate" files, files which will -- simply be added to the final debianization without any -- understanding of their contents or purpose. inputDebianizationFile :: MonadIO m => FilePath -> DebianT m () inputDebianizationFile path = do inputCabalInfoFromDirectory liftIO (readFileMaybe path) >>= maybe (return ()) (\ text -> intermediateFiles %= Set.insert (path, text)) inputSourceDebDescription :: MonadIO m => DebianT m (S.SourceDebDescription, [Field]) inputSourceDebDescription = do paras <- liftIO $ parseControlFromFile "debian/control" >>= either (error . show) (return . unControl) case paras of [] -> error "Missing source paragraph" [_] -> error "Missing binary paragraph" (hd : tl) -> return $ parseSourceDebDescription hd tl parseSourceDebDescription :: Paragraph' String -> [Paragraph' String] -> (S.SourceDebDescription, [Field]) parseSourceDebDescription (Paragraph fields) binaryParagraphs = foldr readField (src, []) fields' where fields' = map stripField fields src = 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' (bins, _extra) = unzip $ map parseBinaryDebDescription binaryParagraphs readField :: Field -> (S.SourceDebDescription, [Field]) -> (S.SourceDebDescription, [Field]) -- Mandatory readField (Field ("Source", _)) x = x readField (Field ("Maintainer", _)) x = x -- readField (Field ("Standards-Version", _)) x = x -- Recommended readField (Field ("Standards-Version", value)) (desc, unrecognized) = (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) = (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 ("X-Description", value)) (desc, unrecognized) = (set S.xDescription (Just (pack value)) desc, unrecognized) readField field@(Field ('X' : fld, value)) (desc, unrecognized) = case span (`elem` "BCS") fld of (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) parseBinaryDebDescription :: Paragraph' String -> (BinaryDebDescription, [Field]) parseBinaryDebDescription (Paragraph fields) = foldr readField (bin, []) fields' where fields' = map stripField fields bin = set B.architecture (Just arch) (newBinaryDebDescription b) b :: BinPkgName b = findMap "Package" BinPkgName fields' arch = findMap "Architecture" parsePackageArchitectures fields' {- (BinPkgName (fromJust (fieldValue "Package" bin))) (read' (fromJust (fieldValue "Architecture" bin))) , [] foldr readField (newBinaryDebDescription (BinPkgName (fromJust (fieldValue "Package" bin))) (read' (fromJust (fieldValue "Architecture" bin))), []) (map stripField fields) -} readField :: Field -> (BinaryDebDescription, [Field]) -> (BinaryDebDescription, [Field]) readField (Field ("Package", x)) (desc, unrecognized) = (set B.package (BinPkgName x) desc, unrecognized) readField (Field ("Architecture", x)) (desc, unrecognized) = (set B.architecture (Just (parsePackageArchitectures x)) desc, unrecognized) readField (Field ("Multi-Arch", x)) (desc, unrecognized) = (set B.multiArch (Just (readMultiArch 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 findMap :: String -> (String -> a) -> [Field] -> a findMap field f fields = fromMaybe (error $ "Missing " ++ show field ++ " field in " ++ show fields) (foldr findMap' Nothing fields) where findMap' (Field (fld, val)) x = if fld == field then Just (f val) else x findMap' _ x = x stripField :: ControlFunctions a => Field' a -> Field' a stripField (Field (a, b)) = Field (a, stripWS b) stripField x = x rels :: String -> Relations rels s = either (\ e -> error ("Relations field error: " ++ show e ++ "\n " ++ s)) id (parseRelations s) yes :: String -> Bool yes "yes" = True yes "no" = False yes x = error $ "Expecting yes or no: " ++ x inputChangeLog :: MonadIO m => DebianT m () inputChangeLog = do log <- liftIO $ tryIOError (readFile "debian/changelog" >>= return . parseChangeLog . unpack) changelog .?= either (\ _ -> Nothing) Just log inputCabalInfoFromDirectory :: MonadIO m => DebianT m () -- .install files, .init files, etc. inputCabalInfoFromDirectory = do findFiles doFiles ("./debian/cabalInstall") where -- Find regular files in the debian/ or in debian/source/format/ and -- add them to the debianization. findFiles :: MonadIO m => DebianT m () findFiles = liftIO (getDirectoryContents' ("debian")) >>= return . (++ ["source/format"]) >>= liftIO . filterM (doesFileExist . (("debian") )) >>= \ names -> mapM_ (inputCabalInfo ("debian")) names doFiles :: MonadIO m => FilePath -> DebianT m () doFiles tmp = do sums <- liftIO $ getDirectoryContents' tmp `catchIOError` (\ _ -> return []) paths <- liftIO $ mapM (\ sum -> getDirectoryContents' (tmp sum) >>= return . map (sum )) sums >>= return . filter ((/= '~') . last) . concat files <- liftIO $ mapM (readFile . (tmp )) paths mapM_ (\ 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. -- This may mean using a specialized parser from the debian package -- (e.g. parseChangeLog), and some files (like control) are ignored -- here, though I don't recall why at the moment. inputCabalInfo :: MonadIO m => FilePath -> FilePath -> DebianT m () inputCabalInfo _ path | elem path ["control"] = return () inputCabalInfo debian name@"source/format" = liftIO (readFile (debian name)) >>= \ text -> either (\ x -> warning %= Set.insert x) ((sourceFormat .=)) (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 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 %= 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 %= 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 (_, ".setup") -> return () -- Compiled Setup.hs file (_, ".substvars") -> return () -- Unsupported (_, "") -> return () -- File with no extension (_, x) | last x == '~' -> return () -- backup file _ -> liftIO (putStrLn $ "Ignored debianization file: " ++ debian name) -- | Read a line from a debian .links file readLink :: Monad m => BinPkgName -> Text -> DebianT m () readLink p line = case words line of [a, b] -> link p (unpack a) (unpack b) [] -> return () _ -> trace ("Unexpected value passed to readLink: " ++ show line) (return ()) -- | Read a line from a debian .install file readInstall :: Monad m => BinPkgName -> Text -> DebianT m () readInstall p line = case break isSpace line of (_, b) | null b -> error $ "readInstall: syntax error in .install file for " ++ show p ++ ": " ++ show line (a, b) -> install p (unpack (strip a)) (unpack (strip b)) -- | Read a line from a debian .dirs file readDir :: Monad m => BinPkgName -> Text -> DebianT m () readDir p line = installDir p (unpack line) -- chroot :: NFData a => FilePath -> IO a -> IO a -- chroot "/" task = task -- chroot root task = useEnv root (return . force) task -- | Where to put the installed data files. Computes the destination -- directory from a Cabal package description. This needs to match -- the path cabal assigns to datadir in the -- dist/build/autogen/Paths_packagename.hs module, or perhaps the path -- in the CABAL_DEBIAN_DATADIR environment variable. dataDest :: Monad m => CabalT m FilePath dataDest = do d <- use packageDescription return $ "usr/share" ((\ (PackageName x) -> x) $ pkgName $ Cabal.package d) -- | Where to look for the data-files dataTop :: Monad m => CabalT m FilePath dataTop = do d <- use packageDescription return $ case Cabal.dataDir d of "" -> "." x -> x cabal-debian-4.31/src/Debian/Debianize/InputCabal.hs0000644000000000000000000000674612565162075020360 0ustar0000000000000000-- | Input the Cabal package description. {-# LANGUAGE CPP, DeriveDataTypeable, TemplateHaskell #-} module Debian.Debianize.InputCabal ( inputCabalization ) where import Control.Exception (bracket) import Control.Lens import Control.Monad (when) import Control.Monad.Trans (MonadIO, liftIO) 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) import Debian.GHC (getCompilerInfo) #else import Debian.GHC (newestAvailableCompilerId) #endif import Debian.Orphans () 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 System.Directory (doesFileExist, getCurrentDirectory) import System.Exit (ExitCode(..)) import System.Posix.Files (setFileCreationMask) import System.Process (system) import System.Unix.Mount (WithProcAndSys) -- | Load a PackageDescription using the information in the Flags record - -- in particular, using the dependency environment in the EnvSet, find -- the newest available compiler of the requested compiler flavor and -- use that information load the configured PackageDescription. inputCabalization :: MonadIO m => Flags -> WithProcAndSys m PackageDescription inputCabalization 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 (view compilerFlavor flags) #else 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) (\ (pkgDesc, _) -> do liftIO $ bracket (setFileCreationMask 0o022) setFileCreationMask $ \ _ -> autoreconf vb pkgDesc return (Right pkgDesc)) finalized either (\ deps -> liftIO getCurrentDirectory >>= \ here -> error $ "Missing dependencies in cabal package at " ++ here ++ ": " ++ show deps) return ePkgDesc -- | Run the package's configuration script. autoreconf :: Verbosity -> Cabal.PackageDescription -> IO () autoreconf verbose pkgDesc = do ac <- doesFileExist "configure.ac" when ac $ do c <- doesFileExist "configure" when (not c) $ do setupMessage verbose "Running autoreconf" (packageId pkgDesc) ret <- system "autoreconf" case ret of ExitSuccess -> return () ExitFailure n -> die ("autoreconf failed with status " ++ show n) cabal-debian-4.31/src/Debian/Debianize/CabalInfo.hs0000644000000000000000000000762512565162075020151 0ustar0000000000000000{-# LANGUAGE CPP, DeriveDataTypeable, OverloadedStrings, TemplateHaskell #-} {-# OPTIONS_GHC -Wall #-} module Debian.Debianize.CabalInfo ( -- * Types CabalInfo , PackageInfo(PackageInfo, cabalName, devDeb, docDeb, profDeb) -- * Lenses , packageDescription , debInfo , debianNameMap , epochMap , packageInfo -- * Builder , newCabalInfo ) where import Control.Lens import Control.Monad.Catch (MonadMask) import Control.Monad.State (execStateT) import Control.Monad.Trans (MonadIO, liftIO) import Data.Generics (Data, Typeable) import Data.Map as Map (Map) import Data.Monoid (Monoid(..)) import Data.Text as Text (null, pack, strip) import Debian.Debianize.BasicInfo (Flags) import Debian.Debianize.DebInfo as D (control, copyright, DebInfo, makeDebInfo) import Debian.Debianize.BinaryDebDescription (Canonical(canonical)) import Debian.Debianize.CopyrightDescription (defaultCopyrightDescription) import Debian.Debianize.InputCabal (inputCabalization) import Debian.Debianize.SourceDebDescription as S (homepage) import Debian.Debianize.VersionSplits (VersionSplits) import Debian.Orphans () import Debian.Relation (BinPkgName) import Debian.Version (DebianVersion) import Distribution.Package (PackageName) import Distribution.PackageDescription as Cabal (PackageDescription(homepage)) import Prelude hiding (init, init, log, log, null) import System.Unix.Mount (withProcAndSys) -- | Bits and pieces of information about the mapping from cabal package -- names and versions to debian package names and versions. In essence, -- an 'Atoms' value represents a package's debianization. The lenses in -- this module are used to get and set the values hidden in this Atoms -- value. Many of the values should be left alone to be set when the -- debianization is finalized. data CabalInfo = CabalInfo { _packageDescription :: PackageDescription -- ^ The result of reading a cabal configuration file. , _debInfo :: DebInfo -- ^ Information required to represent a non-cabal debianization. , _debianNameMap :: Map PackageName VersionSplits -- ^ Mapping from cabal package name and version to debian source -- package name. This allows different ranges of cabal versions to -- map to different debian source package names. , _epochMap :: Map PackageName Int -- ^ Specify epoch numbers for the debian package generated from a -- cabal package. Example: @EpochMapping (PackageName "HTTP") 1@. , _packageInfo :: Map PackageName PackageInfo -- ^ Supply some info about a cabal package. } deriving (Show, Data, Typeable) data PackageInfo = PackageInfo { cabalName :: PackageName , devDeb :: Maybe (BinPkgName, DebianVersion) , profDeb :: Maybe (BinPkgName, DebianVersion) , docDeb :: Maybe (BinPkgName, DebianVersion) } deriving (Eq, Ord, Show, Data, Typeable) $(makeLenses ''CabalInfo) instance Canonical CabalInfo where canonical x = x {_debInfo = canonical (_debInfo x)} -- | Given the 'Flags' value read the cabalization and build a new -- 'CabalInfo' record. newCabalInfo :: (MonadIO m, MonadMask m) => Flags -> m CabalInfo newCabalInfo flags' = withProcAndSys "/" $ do pkgDesc <- inputCabalization flags' copyrt <- liftIO $ defaultCopyrightDescription pkgDesc execStateT (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) makeCabalInfo :: Flags -> PackageDescription -> CabalInfo makeCabalInfo fs pkgDesc = CabalInfo { _packageDescription = pkgDesc , _epochMap = mempty , _packageInfo = mempty , _debianNameMap = mempty , _debInfo = makeDebInfo fs } cabal-debian-4.31/src/Debian/Debianize/Optparse.hs0000644000000000000000000006165712565162075020135 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} module Debian.Debianize.Optparse ( CommandLineOptions(..), BehaviorAdjustment, Flags(..), parseProgramArguments, parseProgramArguments', handleBehaviorAdjustment) where import Control.Applicative ((<$>), (<*>), many, pure, (<|>)) import Control.Lens import Control.Monad.State.Class (MonadState) import Control.Monad.Trans import Control.Newtype import Data.Bifunctor (first) import Data.Char(toUpper) import Data.Foldable (forM_) import Data.Maybe.Extended (fromMaybe) import Data.Maybe.Extended (nothingIf) import Data.Monoid ((<>)) import Debian.Debianize.BasicInfo import Debian.Debianize.DebInfo (TestsStatus(..)) import Debian.Debianize.Monad import Debian.Debianize.Prelude (maybeRead) import Debian.Debianize.VersionSplits import Debian.Policy import Debian.Relation import Debian.Version.Common (DebianVersion, parseDebianVersion) import Distribution.Compiler (CompilerFlavor(..)) import Distribution.Package (PackageName(..)) import Distribution.PackageDescription (FlagName(FlagName)) import GHC.Generics import System.Environment (getArgs) import System.FilePath(splitFileName, ()) import System.Posix.Env (getEnv) import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr(..)) import Text.PrettyPrint.ANSI.Leijen (linebreak, (<+>), string, indent) import qualified Debian.Debianize.DebInfo as D import qualified Data.Map as Map import qualified Data.Set as Set import qualified Debian.Debianize.BinaryDebDescription as B import qualified Debian.Debianize.CabalInfo as A import qualified Debian.Debianize.SourceDebDescription as S import qualified Options.Applicative as O data HaddockStatus = HaddockEnabled | HaddockDisabled deriving Eq data ProfilingStatus = ProfilingEnabled | ProfilingDisabled deriving Eq data OfficialStatus = Official| NonOfficial deriving Eq newtype BuildDep = BuildDep Relations deriving Generic instance Newtype BuildDep newtype BuildDepIndep = BuildDepIndep Relations deriving Generic instance Newtype BuildDepIndep newtype DevDep = DevDep Relations deriving Generic instance Newtype DevDep newtype ExtraDepends = ExtraDepends (BinPkgName, Relations) deriving Generic instance Newtype ExtraDepends newtype ExtraConflicts = ExtraConflicts (BinPkgName, Relations) deriving Generic instance Newtype ExtraConflicts newtype ExtraProvides = ExtraProvides (BinPkgName, Relations) deriving Generic instance Newtype ExtraProvides newtype ExtraReplaces = ExtraReplaces (BinPkgName, Relations) deriving Generic instance Newtype ExtraReplaces newtype ExtraRecommends = ExtraRecommends (BinPkgName, Relations) deriving Generic instance Newtype ExtraRecommends newtype ExtraSuggests = ExtraSuggests (BinPkgName, Relations) deriving Generic instance Newtype ExtraSuggests newtype CabalDebMapping = CabalDebMapping (PackageName, Relations) deriving Generic instance Newtype CabalDebMapping newtype ExecDebMapping = ExecDebMapping (String, Relations) deriving Generic instance Newtype ExecDebMapping newtype Revision = Revision String deriving Generic instance Newtype Revision newtype CabalEpochMapping = CabalEpochMapping (PackageName, Int) deriving Generic instance Newtype CabalEpochMapping newtype CabalFlagMapping = CabalFlagMapping (FlagName, Bool) deriving Generic instance Newtype CabalFlagMapping -- | This data type is an abomination. It represent information, -- provided on command line. Part of such information provides -- means to create initial 'CabalT' state and is stored in -- '_flags' field. See 'newCabalInfo'. -- -- Other, much greater part represent changes to already created -- state. They are stored in '_adjustment' field. -- -- All this can be understood from (simplified) types: -- -- > type CabalT m a = StateT CabalInfo m a -- > newCabalInfo :: Flags -> IO CabalInfo -- > handleBehaviorAdjustment :: BehaviorAdjustment -> CabalT IO () data CommandLineOptions = CommandLineOptions { _flags :: Flags, _adjustment :: BehaviorAdjustment } -- | This data type represents changes to 'CabalT' state, -- requested at command line. data BehaviorAdjustment = BehaviorAdjustment { _maintainer :: NameAddr, _uploaders :: [NameAddr], _executable :: [(BinPkgName, D.InstallFile)], _defaultPackage :: Maybe String, _missingDependency :: [BinPkgName], _debianNameBase :: Maybe DebBase, _debianVersion :: Maybe DebianVersion, _revision :: Maybe Revision, _sourcePackageName :: Maybe SrcPkgName, _sourceSection :: Section, _standardsVersion :: StandardsVersion, _buildDep :: [BuildDep], _buildDepIndep :: [BuildDepIndep], _devDep :: [DevDep], _extraDepends :: [ExtraDepends], _extraConflicts :: [ExtraConflicts], _extraProvides :: [ExtraProvides], _extraReplaces :: [ExtraReplaces], _extraRecommends :: [ExtraRecommends], _extraSuggests :: [ExtraSuggests], _cabalDebMapping :: [CabalDebMapping], _cabalEpochMapping :: [CabalEpochMapping], _execDebMapping :: [ExecDebMapping], _profiling :: ProfilingStatus, _haddock :: HaddockStatus, _official :: OfficialStatus, _sourceFormat :: SourceFormat, _tests :: TestsStatus } -- Brief instruction to save you, dear developer from scrutinizing -- `optparse-applicative` documentation. -- -- There is two main types in command line parsing. -- -- 'ReadM' is description how make object from string. -- For every object of type 'a' with some parsing logic -- we define auxiliary function with 'R' suffix and -- type 'ReadM a'. -- -- 'Parser' is type, containing information about -- which string in command line should be converted -- to object. Every field in 'BehaviorAdjustment' -- and 'Flags' type of type 'b' have corresponding function -- of type 'Parser' with suffix 'P'. -- Here are all 'ReadM' values. executableR :: O.ReadM (BinPkgName, D.InstallFile) executableR = parsePair . span (/= ':') <$> O.str where parsePair :: (String, String) -> (BinPkgName, D.InstallFile) parsePair (sp, md) = let (sd, name) = splitFileName sp in (BinPkgName name, D.InstallFile { D.execName = name, D.destName = name, D.sourceDir = nothingIf ( == "./") sd, D.destDir = case md of (':' : dd) -> Just dd _ -> Nothing }) binPkgNameR :: O.ReadM BinPkgName binPkgNameR = BinPkgName <$> O.str nameAddrR :: O.ReadM NameAddr nameAddrR = either fail return =<< parseMaintainer <$> O.str relationsR :: O.ReadM Relations relationsR = either (fail . show) return =<< parseRelations <$> O.str mappingR :: O.ReadM (String, Relations) mappingR = span (/= ':') <$> O.str >>= \case (str, "") -> fail $ "Does not contains colon: `" ++ str ++ "'" (pkgstr, _ : relstr) -> do rels <- either (fail . show) return $ parseRelations relstr return (pkgstr, rels) epochMappingR :: O.ReadM (String, Int) epochMappingR = span (/= '=') <$> O.str >>= \case (pkgstr, '=' : numstr) -> do let epoch = fromMaybe (error ("Invalid epoch: " ++ numstr)) (maybeRead numstr :: Maybe Int) return (pkgstr, epoch) (str, _) -> fail $ "Does not contains equals: `" ++ str ++ "'" extraRelationsR :: O.ReadM (BinPkgName, Relations) extraRelationsR = first BinPkgName <$> mappingR cabalDebMappingR :: O.ReadM CabalDebMapping cabalDebMappingR = CabalDebMapping . first PackageName <$> mappingR cabalEpochMappingR :: O.ReadM CabalEpochMapping cabalEpochMappingR = CabalEpochMapping . first PackageName <$> epochMappingR cabalFlagMappingR :: O.ReadM CabalFlagMapping cabalFlagMappingR = O.str >>= \case ('-' : str) -> return $ CabalFlagMapping (FlagName str, False) str -> return $ CabalFlagMapping (FlagName str, True) -- Here are parser for BehaviorAdjustment and next are parsers for -- every field of this data. Please, keep parsers declarations in -- same order, as are fields. behaviorAdjustmentP :: O.Parser BehaviorAdjustment behaviorAdjustmentP = BehaviorAdjustment <$> maintainerP <*> uploadersP <*> executableP <*> defaultPackageP <*> missingDependencyP <*> debianNameBaseP <*> debianVersionP <*> debianRevisionP <*> sourcePackageNameP <*> sourceSectionP <*> standardsVersionP <*> buildDepP <*> buildDepIndepP <*> devDepP <*> extraDependsP <*> extraConflictsP <*> extraProvidesP <*> extraReplacesP <*> extraRecommendsP <*> extraSuggestsP <*> cabalDebMappingP <*> cabalEpochMappingP <*> execDebMappingP <*> profilingP <*> haddockP <*> officialP <*> sourceFormatP <*> testsP maintainerP :: O.Parser NameAddr maintainerP = O.option nameAddrR m where m = O.help helpMsg <> O.long "maintainer" <> O.short 'm' <> O.value (NameAddr (Just "Debian Haskell Group") "pkg-haskell-maintainers@lists.alioth.debian.org") <> O.metavar "'NAME '" helpMsg = "Set the `Maintainer' field in debian/control file." uploadersP :: O.Parser [NameAddr] uploadersP = many $ O.option nameAddrR m where m = O.help helpMsg <> O.long "uploader" <> O.short 'u' <> O.metavar "'NAME '" helpMsg = "Add entry to `Uploaders' field in debian/control file." executableP :: O.Parser [(BinPkgName, D.InstallFile)] executableP = many $ O.option executableR m where m = O.help helpMsg <> O.long "executable" <> O.short 'e' <> O.metavar "SOURCEPATH[:DESTDIR]" helpMsg = unlines [ "Create an individual binary package to hold this executable.", "Other executables and data files are gathered into a single package", "named `haskell-PACKAGENAME-utils'" ] defaultPackageP :: O.Parser (Maybe String) defaultPackageP = O.option (Just <$> O.str) m where m = O.help helpMsg <> O.long "default-package" <> O.short 'd' <> O.value Nothing <> O.metavar "PKGNAME" helpMsg = 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'" ] missingDependencyP :: O.Parser [BinPkgName] missingDependencyP = many $ O.option binPkgNameR m where m = O.help helpMsg <> O.long "missing-dependency" <> O.metavar "DEB" helpMsg = 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." ] debianNameBaseP :: O.Parser (Maybe DebBase) debianNameBaseP = O.option (Just . DebBase <$> O.str) m where m = O.help helpMsg <> O.long "debian-name-base" <> O.short 'b' <> O.value Nothing <> O.metavar "NAME" helpMsg = 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." ] debianVersionP :: O.Parser (Maybe DebianVersion) debianVersionP = O.option (Just . parseDebianVersion <$> O.str) m where m = O.help helpMsg <> O.long "deb-version" <> O.metavar "DEBIANVERSION" <> O.value Nothing helpMsg = unlines [ "Specify the version number for the debian package.", "This will pin the version and should be considered dangerous." ] debianRevisionP :: O.Parser (Maybe Revision) debianRevisionP = O.option (Just . Revision <$> O.str) m where m = O.help helpMsg <> O.long "revision" <> O.value Nothing <> O.metavar "DEBIANREVISION" helpMsg = unlines [ "Add this string to the cabal version to get the debian version number.", "Debian policy says this must either be empty (--revision '')", "or begin with a dash." ] sourcePackageNameP :: O.Parser (Maybe SrcPkgName) sourcePackageNameP = O.option (Just . SrcPkgName <$> O.str) m where m = O.help helpMsg <> O.long "source-package-name" <> O.short 's' <> O.value Nothing <> O.metavar "DEBIANNAME" helpMsg = 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 it is haskell-,", "where the cabal package name is downcased." ] sourceSectionP :: O.Parser Section sourceSectionP = O.option (MainSection <$> O.str) m where m = O.help helpMsg <> O.long "source-section" <> O.short 'S' <> O.value (MainSection "haskell") <> O.metavar "SECTION" helpMsg = "Set the `Section' field in debian/control file." standardsVersionP :: O.Parser StandardsVersion standardsVersionP = O.option (parseStandardsVersion <$> O.str) m where m = O.help helpMsg <> O.long "standards-version" <> O.value (parseStandardsVersion "3.9.6") <> O.metavar "CABALVERSION" helpMsg = unlines [ "Claim compatibility to this version of the Debian policy", "(i.e. the value of the Standards-Version field)" ] buildDepP :: O.Parser [BuildDep] buildDepP = many $ O.option (BuildDep <$> relationsR) m where m = O.help helpMsg <> O.long "build-dep" <> O.metavar "DEBIANRELATIONS" helpMsg = unlines [ "Add a dependency relation to the `Build-Depends'", "field for this source package." ] buildDepIndepP :: O.Parser [BuildDepIndep] buildDepIndepP = many $ O.option (BuildDepIndep <$> relationsR) m where m = O.help helpMsg <> O.long "build-dep-indep" <> O.metavar "DEBIANRELATIONS" helpMsg = unlines [ "Add a dependency relation to the `Build-Depends-Indep'", "field for this source package." ] devDepP :: O.Parser [DevDep] devDepP = many $ O.option (DevDep <$> relationsR) m where m = O.help helpMsg <> O.long "dev-dep" <> O.metavar "RELATION" helpMsg = "Add an entry to the `Depends' field of the -dev package" -- Since `depends', `conflicts' and so on options are totally same, -- we can avoid code via this function, which, given long option name -- makes correct O.Parser. Newtype around (BinPkgName, Relations) -- is inferred, but there is still some duplication. -- -- Long option name can also be inferred from Typeable instance of -- mentioned newtype, but this would introduce some amount of -- low-level string manipulations. -- -- Nice to know, but now, to me, it would introduce more complexity, -- than eliminate. mkExtraP :: (Newtype n, O n ~ (BinPkgName, Relations)) => String -> O.Parser [n] mkExtraP long@(c:cr) = many $ O.option (pack <$> extraRelationsR) m where fieldName = toUpper c : cr m = O.help helpMsg <> O.long long <> O.metavar "DEB:RELATION" helpMsg = "Add extry to '" ++ fieldName ++ " 'field of DEB binary package" mkExtraP "" = error "mkExtraP: empty long option" extraDependsP :: O.Parser [ExtraDepends] extraDependsP = mkExtraP "depends" extraConflictsP :: O.Parser [ExtraConflicts] extraConflictsP = mkExtraP "conflicts" extraProvidesP :: O.Parser [ExtraProvides] extraProvidesP = mkExtraP "provides" extraReplacesP :: O.Parser [ExtraReplaces] extraReplacesP = mkExtraP "replaces" extraRecommendsP :: O.Parser [ExtraRecommends] extraRecommendsP = mkExtraP "recommends" extraSuggestsP :: O.Parser [ExtraSuggests] extraSuggestsP = mkExtraP "suggests" cabalDebMappingP :: O.Parser [CabalDebMapping] cabalDebMappingP = many $ O.option cabalDebMappingR m where m = O.help helpMsg <> O.long "dep-map" <> O.metavar "CABAL:DEBIANBINARYPACKAGE" helpMsg = 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." ] execDebMappingP :: O.Parser [ExecDebMapping] execDebMappingP = many $ O.option (ExecDebMapping <$> mappingR) m where m = O.help helpMsg <> O.long "exec-map" <> O.metavar "CABAL:DEBIANBINARYPACKAGE" helpMsg = unlines [ "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" ] cabalEpochMappingP :: O.Parser [CabalEpochMapping] cabalEpochMappingP = many $ O.option (cabalEpochMappingR) m where m = O.help helpMsg <> O.long "epoch-map" <> O.metavar "CABALPACKAGE=DIGIT" helpMsg = unlines [ "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" ] cabalFlagsP :: O.Parser [CabalFlagMapping] cabalFlagsP = many $ O.option (cabalFlagMappingR) m where m = O.help helpMsg <> O.long "cabal-flags" <> O.long "cabal-flag" <> O.metavar "CABALFLAG or -CABALFLAG" helpMsg = "Flags to pass to cabal configure with the --flags= option" profilingP :: O.Parser ProfilingStatus profilingP = O.flag ProfilingEnabled ProfilingDisabled m where m = O.help helpMsg <> O.long "disable-profiling" helpMsg = "Do not generate profiling (-prof) library package." haddockP :: O.Parser HaddockStatus haddockP = O.flag HaddockEnabled HaddockDisabled m where m = O.help helpMsg <> O.long "disable-haddock" helpMsg = "Do not build haddoc documentation" officialP :: O.Parser OfficialStatus officialP = O.flag NonOfficial Official m where m = O.help helpMsg <> O.long "official" helpMsg = "Follow guidelines of Debian Haskell Group" sourceFormatP :: O.Parser SourceFormat sourceFormatP = O.flag Quilt3 Native3 m where m = O.help helpMsg <> O.long "native" helpMsg = unlines [ "Package has an no upstream tarball,", "write '3.0 (native)' into source/format." ] testsP :: O.Parser TestsStatus testsP = buildOnlyTestsP <|> disableTestsP disableTestsP :: O.Parser TestsStatus disableTestsP = O.flag TestsRun TestsDisable m where m = O.help "disable test suite" <> O.long "disable-tests" <> O.long "no-tests" buildOnlyTestsP :: O.Parser TestsStatus buildOnlyTestsP = O.flag TestsRun TestsBuild m where m = O.help "build, but do not run test suite" <> O.long "no-run-tests" <> O.long "disable-running-tests" -- Here is 'Flags' parser and parsers for every it's field. flagsP :: O.Parser Flags flagsP = Flags <$> verbosityP <*> dryRunP <*> upgradeP <*> roundtripP <*> pure False -- validate <*> ghcjsP -- CompilerFlavor <*> (flagSet <$> cabalFlagsP) -- cabalFlagAssignments <*> buildEnvDirP where flagSet cfms = Set.fromList (map (\ (CabalFlagMapping (name, bool)) -> (name, bool)) cfms) verbosityP :: O.Parser Int verbosityP = length <$> many (O.flag' () m) where m = O.help helpMsg <> O.short 'v' <> O.long "verbose" helpMsg = unlines [ "Every instance of this flag increases amount", "of progress messages generated" ] dryRunP :: O.Parser Bool dryRunP = O.switch m where m = O.help helpMsg <> O.short 'n' <> O.long "dry-run" helpMsg = unlines [ "Just compare the existing debianization", "to the one we would generate." ] upgradeP :: O.Parser Bool upgradeP = O.switch m where m = O.help helpMsg <> O.long "upgrade" helpMsg = unlines [ "Upgrade an existing debianization carefully", "preserving fields that are commonly hand-edited." ] roundtripP :: O.Parser Bool roundtripP = O.switch m where m = O.help helpMsg <> O.long "roundtrip" helpMsg = unlines [ "Roundtrip a debianization to normalize it." ] ghcjsP :: O.Parser CompilerFlavor ghcjsP = O.flag GHC #if MIN_VERSION_Cabal(1,22,0) GHCJS #else GHC #endif m where m = O.help helpMsg <> O.long "ghcjs" helpMsg = "Set compiler flavor to GHCJS." buildEnvDirP :: O.Parser EnvSet buildEnvDirP = O.option ((\s -> EnvSet {cleanOS = s "clean", dependOS = s "depend", buildOS = s "build"}) <$> O.str) m where m = O.help "Directory containing the three build environments, clean, depend, and build." <> O.long "buildenvdir" <> O.value (EnvSet {cleanOS = "/", dependOS = "/", buildOS = "/"}) <> O.metavar "DIR" commandLineOptionsP :: O.Parser CommandLineOptions commandLineOptionsP = CommandLineOptions <$> flagsP <*> behaviorAdjustmentP commandLineOptionsParserInfo :: [String] -> O.ParserInfo CommandLineOptions commandLineOptionsParserInfo args = O.info (O.helper <*> commandLineOptionsP) im where im = O.header "cabal-debian -- create debianization of cabal package" <> O.fullDesc <> O.progDescDoc (Just descDoc) descDoc = "Typical usage is run in unpacked source root directory" <+> linebreak <+> linebreak <+> indent 2 "% cabal-debian --maintainer 'Maintainer Name '" <+> linebreak <+> linebreak <+> (string . unlines $ [ "This will read the package's cabal file and any existing debian/changelog file and", "deduce what it can about the debianization, then it will create or modify files in", "the debian subdirectory. Note that it will not remove any files in debian, and", "these could affect the operation of the debianization in unknown ways. For this", "reason it is recommended either using a pristine unpacked directory each time, or else", "using a revision control system to revert the package to a known state before running.", "", "Arguments: " ++ show args ]) -- FIXME: Separation of parsing of `BehaviorAdjustment' and performing -- of corresponding actions is all great, but now it is pretty easy -- to not handle particular field in `BehaviorAdjustment' field and -- ghc will not complain. handleBehaviorAdjustment :: (MonadIO m, Functor m) => BehaviorAdjustment -> CabalT m () handleBehaviorAdjustment (BehaviorAdjustment {..}) = do forM_ _cabalEpochMapping $ \(CabalEpochMapping (pkg, num)) -> A.epochMap %= Map.insert pkg num zoom A.debInfo $ do forM_ _executable $ (D.executable %=) . uncurry Map.insert forM_ _execDebMapping $ (D.execMap %=) . uncurry Map.insert . unpack forM_ _missingDependency $ (D.missingDependencies %=) . Set.insert D.utilsPackageNameBase .= _defaultPackage D.noDocumentationLibrary .= (_haddock == HaddockDisabled) D.noProfilingLibrary .= (_profiling == ProfilingDisabled) D.overrideDebianNameBase .= _debianNameBase D.sourcePackageName .= _sourcePackageName D.maintainerOption .= Just _maintainer D.sourceFormat .= _sourceFormat D.revision .= unpack `fmap` _revision D.debVersion .= _debianVersion D.uploadersOption %= (++ _uploaders) D.extraDevDeps %= (++ concatMap unpack _devDep) forM_ _cabalDebMapping $ \(CabalDebMapping (PackageName pkg, rels)) -> do D.extraLibMap %= Map.insert pkg rels addExtra _extraDepends B.depends addExtra _extraConflicts B.conflicts addExtra _extraProvides B.provides addExtra _extraReplaces B.replaces addExtra _extraRecommends B.recommends addExtra _extraSuggests B.suggests D.testsStatus .= _tests D.official .= (_official == Official) zoom D.control $ do S.section .= Just _sourceSection S.standardsVersion .= Just _standardsVersion S.buildDepends %= (++ concatMap unpack _buildDep) S.buildDepends %= (++ concatMap unpack _devDep) S.buildDependsIndep %= (++ concatMap unpack _buildDepIndep) addExtra :: (MonadState D.DebInfo m, Newtype n, O n ~ (BinPkgName, Relations)) => [n] -> Lens' B.PackageRelations Relations -> m () addExtra extra lens' = forM_ extra $ \arg -> do let (pkg, rel) = unpack arg D.binaryDebDescription pkg . B.relations . lens' %= (++ rel) parseProgramArguments' :: [String] -> IO CommandLineOptions parseProgramArguments' args = O.handleParseResult result where prefs = O.prefs O.idm result = O.execParserPure prefs (commandLineOptionsParserInfo args) args parseProgramArguments :: IO CommandLineOptions parseProgramArguments = getArgs >>= parseProgramArguments' cabal-debian-4.31/src/Debian/Debianize/BasicInfo.hs0000644000000000000000000001372112565162075020162 0ustar0000000000000000-- | The basic information required to load a Cabal or Debian package description. {-# LANGUAGE CPP, DeriveDataTypeable, TemplateHaskell #-} module Debian.Debianize.BasicInfo ( -- * Types Flags(..) , EnvSet(..) , DebType(..) -- * Lenses , verbosity , dryRun , upgrade , roundtrip , validate , compilerFlavor , cabalFlagAssignments , buildEnv -- * State Monad , flagOptions ) where import Control.Lens import Control.Monad.State (StateT) import Control.Monad.Trans (MonadIO) import Data.Char (toLower, toUpper) import Data.Generics (Data, Typeable) import Data.Set as Set (fromList, Set, union) import Debian.Debianize.Prelude (read') import Debian.Orphans () import Distribution.Compiler (CompilerFlavor(..)) import Distribution.PackageDescription as Cabal (FlagName(FlagName)) import Prelude hiding (break, lines, log, null, readFile, sum) import System.Console.GetOpt (ArgDescr(ReqArg, NoArg), OptDescr(Option)) import System.FilePath (()) import Text.Read (readMaybe) -- | This record supplies enough information to locate and load a debianization -- or a cabal file from the IO monad. data Flags = Flags { _verbosity :: Int -- ^ Run with progress messages at the given level of verboseness. , _dryRun :: Bool -- ^ Don't write any files or create any directories, just explain -- what would have been done. , _upgrade :: Bool -- ^ Carefully upgrade the packaging , _roundtrip :: Bool -- ^ Normalize a debianization (field order, whitespace) by round-tripping it. , _validate :: Bool -- ^ Fail if the debianization already present doesn't match the -- one we are going to generate closely enough that it is safe to -- debianize during the run of dpkg-buildpackage, when Setup -- configure is run. Specifically, the version number in the top -- changelog entry must match, and the sets of package names in -- the control file must match. , _compilerFlavor :: CompilerFlavor -- ^ Which compiler should we generate library packages for? In theory a single -- deb could handle multiple compiler flavors, but the support tools are not ready -- for this as of right now (28 Jan 2015.) , _cabalFlagAssignments :: Set (FlagName, Bool) -- ^ Flags to pass to Cabal function finalizePackageDescription, -- this can be used to control the flags in the cabal file. It -- can be supplied to the cabal-debian binary using the --flags -- option. , _buildEnv :: EnvSet -- ^ Directory containing the build environment for which the -- debianization will be generated. This determines which -- compiler will be available, which in turn determines which -- basic libraries can be provided by the compiler. By default -- all the paths in EnvSet are "/". } deriving (Eq, Ord, Show, Data, Typeable) data EnvSet = EnvSet { cleanOS :: FilePath -- ^ The output of the debootstrap command , dependOS :: FilePath -- ^ An environment with build dependencies installed , buildOS :: FilePath -- ^ An environment where we have built a package } deriving (Eq, Ord, Show, Data, Typeable) -- | A redundant data type, too lazy to expunge. data DebType = Dev | Prof | Doc deriving (Eq, Ord, Read, Show, Data, Typeable) -- Build the lenses $(makeLenses ''Flags) -- | Command line options which build a function that modifies a -- state monad value of type 'Flags' flagOptions :: MonadIO m => [OptDescr (StateT Flags m ())] flagOptions = [ Option "v" ["verbose"] (ReqArg (\ s -> verbosity .= (read' (\ s' -> error $ "verbose: " ++ show s') s :: Int)) "number") "Change the amount of progress messages generated", Option "n" ["dry-run", "compare"] (NoArg (dryRun .= True)) "Just compare the existing debianization to the one we would generate.", Option "" ["upgrade"] (NoArg (upgrade .= True)) "Carefully upgrade an existing debianization", Option "" ["roundtrip"] (NoArg (roundtrip .= True)) "Rountrip a debianization to normalize it", Option "" ["ghc"] (NoArg (compilerFlavor .= GHC)) "Generate packages for GHC - same as --with-compiler GHC", #if MIN_VERSION_Cabal(1,22,0) Option "" ["ghcjs"] (NoArg (compilerFlavor .= GHCJS)) "Generate packages for GHCJS - same as --with-compiler GHCJS", #endif Option "" ["hugs"] (NoArg (compilerFlavor .= Hugs)) "Generate packages for Hugs - same as --with-compiler GHC", Option "" ["with-compiler"] (ReqArg (\ s -> maybe (error $ "Invalid compiler id: " ++ show s) (\ hc -> compilerFlavor .= hc) (readMaybe (map toUpper s) :: Maybe CompilerFlavor)) "COMPILER") (unlines [ "Generate packages for this CompilerFlavor" ]), Option "f" ["flags"] (ReqArg (\ fs -> cabalFlagAssignments %= (Set.union (Set.fromList (flagList fs)))) "FLAGS") -- Option "f" ["flags"] (ReqArg (\ fs p -> foldl (\ p' x -> p' {cabalFlagAssignments_ = Set.insert x (cabalFlagAssignments_ p')}) p (flagList fs)) "FLAGS") (unlines [ "Flags to pass to the finalizePackageDescription function in" , "Distribution.PackageDescription.Configuration when loading the cabal file."]), Option "" ["buildenvdir"] (ReqArg (\ s -> buildEnv .= EnvSet {cleanOS = s "clean", dependOS = s "depend", buildOS = s "build"}) "PATH") "Directory containing the three build environments, clean, depend, and build.", Option "f" ["cabal-flags"] (ReqArg (\ s -> cabalFlagAssignments %= (Set.union (fromList (flagList s)))) "FLAG FLAG ...") "Flags to pass to cabal configure with the --flags= option " ] -- Lifted from Distribution.Simple.Setup, since it's not exported. flagList :: String -> [(FlagName, Bool)] flagList = map tagWithValue . words where tagWithValue ('-':name) = (FlagName (map toLower name), False) tagWithValue name = (FlagName (map toLower name), True) cabal-debian-4.31/src/Debian/Debianize/SourceDebDescription.hs0000644000000000000000000001231512565162075022402 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, TemplateHaskell, TypeSynonymInstances #-} module Debian.Debianize.SourceDebDescription ( SourceDebDescription , newSourceDebDescription , newSourceDebDescription' , source , maintainer , changedBy , uploaders , dmUploadAllowed , priority , section , buildDepends , buildConflicts , buildDependsIndep , buildConflictsIndep , standardsVersion , homepage , vcsFields , xFields , xDescription , binaryPackages , VersionControlSpec(..) , XField(..) , XFieldDest(..) ) where import Control.Lens.TH (makeLenses) import Data.Generics (Data, Typeable) import Data.Set as Set (empty, Set) import Data.Text (Text) import Debian.Debianize.BinaryDebDescription (BinaryDebDescription, Canonical(canonical)) import Debian.Orphans () import Debian.Policy (PackagePriority, Section, StandardsVersion) import Debian.Relation (Relations, SrcPkgName) import Prelude hiding (init, init, log, log, unlines) import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr) -- | This type represents the debian/control file, which is the core -- of the source package debianization. It includes the information -- that goes in the first, or source, section, and then a list of the -- succeeding binary package sections. data SourceDebDescription = SourceDebDescription { _source :: Maybe SrcPkgName -- ^ , _maintainer :: Either String NameAddr -- ^ , _changedBy :: Maybe NameAddr -- ^ , _uploaders :: [NameAddr] -- ^ , _dmUploadAllowed :: Bool -- ^ , _priority :: Maybe PackagePriority -- ^ , _section :: Maybe Section -- ^ , _standardsVersion :: Maybe StandardsVersion -- ^ , _homepage :: Maybe Text -- ^ , _vcsFields :: Set VersionControlSpec -- ^ , _xFields :: Set XField -- ^ , _buildDepends :: Relations , _buildConflicts :: Relations , _buildDependsIndep :: Relations , _buildConflictsIndep :: Relations , _xDescription :: Maybe Text , _binaryPackages :: [BinaryDebDescription] -- ^ The binary debs. This should be a map, but we may need to preserve the order } deriving (Eq, Ord, Show, Data, Typeable) instance Canonical SourceDebDescription where canonical x = x { _binaryPackages = canonical (_binaryPackages x) , _buildDepends = canonical (_buildDepends x) , _buildConflicts = canonical (_buildConflicts x) , _buildDependsIndep = canonical (_buildDependsIndep x) , _buildConflictsIndep = canonical (_buildConflictsIndep x) } newSourceDebDescription :: SourceDebDescription newSourceDebDescription = SourceDebDescription { _source = Nothing , _maintainer = Left "Maintainer not set" , _changedBy = Nothing , _uploaders = [] , _dmUploadAllowed = False , _priority = Nothing , _section = Nothing , _buildDepends = [] , _buildConflicts = [] , _buildDependsIndep = [] , _buildConflictsIndep = [] , _standardsVersion = Nothing , _homepage = Nothing , _vcsFields = Set.empty , _xFields = Set.empty , _xDescription = Nothing -- Quick hack, I should maybe put this into _xFields , _binaryPackages = [] } newSourceDebDescription' :: SrcPkgName -> NameAddr -> SourceDebDescription newSourceDebDescription' src who = newSourceDebDescription { _source = Just src , _maintainer = Right who } data VersionControlSpec = VCSBrowser Text | VCSArch Text | VCSBzr Text | VCSCvs Text | VCSDarcs Text | VCSGit Text | VCSHg Text | VCSMtn Text | VCSSvn Text deriving (Eq, Ord, Show, Data, Typeable) -- | User defined fields. Parse the line "XBS-Comment: I stand -- between the candle and the star." to get XField (fromList "BS") -- "Comment" " I stand between the candle and the star." data XField = XField (Set XFieldDest) Text Text deriving (Eq, Ord, Show, Data, Typeable) data XFieldDest = B -- ^ Field will be copied to the binary packgae control files | S -- ^ Field will be copied to the source packgae control files | C -- ^ Field will be copied to the upload control (.changes) file deriving (Eq, Ord, Read, Show, Data, Typeable) $(makeLenses ''SourceDebDescription) cabal-debian-4.31/src/Debian/Debianize/Files.hs0000644000000000000000000003021612565162075017365 0ustar0000000000000000-- | Convert a Debianization into a list of files that can then be -- written out. {-# LANGUAGE FlexibleContexts, FlexibleInstances, OverloadedStrings, ScopedTypeVariables, TupleSections #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Debian.Debianize.Files ( debianizationFileMap ) where import Control.Applicative ((<$>)) import Control.Lens import Control.Monad.Trans (lift) import Control.Monad.Writer (execWriterT, tell, WriterT) import Data.Char (isSpace) import Data.List as List (dropWhile, dropWhileEnd, map) import Data.Map as Map (fromListWithKey, insertWith, map, Map, mapKeys, toList) import Data.Maybe (fromMaybe) import Data.Monoid ((<>), mempty) import Data.Set as Set (fold, member, toList) import Data.Text as Text (dropWhile, dropWhileEnd, intercalate, lines, null, pack, strip, Text, unlines, unpack) import Debian.Control (Control'(Control, unControl), Field'(Field), Paragraph'(Paragraph)) import Debian.Control.Common () import qualified Debian.Debianize.DebInfo as D (Atom(Install, InstallDir, Link), atomSet, changelog, compat, control, copyright, installInit, intermediateFiles, logrotateStanza, postInst, postRm, preInst, preRm, rulesFragments, rulesHead, rulesIncludes, rulesSettings, sourceFormat, watch) import Debian.Debianize.Monad (DebianT) import Debian.Debianize.Prelude (escapeDebianWildcards, showDeps') import qualified Debian.Debianize.BinaryDebDescription as B (architecture, BinaryDebDescription, binaryPriority, multiArch, binarySection, breaks, builtUsing, conflicts, depends, description, essential, package, PackageRelations, preDepends, provides, recommends, relations, replaces, suggests) import Debian.Debianize.CopyrightDescription (CopyrightDescription) import qualified Debian.Debianize.SourceDebDescription as S (binaryPackages, buildConflicts, buildConflictsIndep, buildDepends, buildDependsIndep, dmUploadAllowed, homepage, maintainer, priority, section, source, SourceDebDescription, standardsVersion, uploaders, vcsFields, VersionControlSpec(VCSArch, VCSBrowser, VCSBzr, VCSCvs, VCSDarcs, VCSGit, VCSHg, VCSMtn, VCSSvn), xDescription, XField(XField), XFieldDest(B, C, S), xFields) import Debian.Policy (maintainerOfLastResort) 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 System.FilePath (()) import Text.PrettyPrint.HughesPJClass (empty, Pretty(pPrint), text) type FilesT m = WriterT [(FilePath, Text)] (DebianT m) instance Pretty (PP Bool) where pPrint = text . show . unPP -- | Turn the Debianization into a list of files, making sure the text -- associated with each path is unique. Assumes that -- finalizeDebianization has already been called. (Yes, I'm -- considering building one into the other, but it is handy to look at -- the Debianization produced by finalizeDebianization in the unit -- tests.) debianizationFileMap :: (Monad m, Functor m) => DebianT m (Map FilePath Text) debianizationFileMap = fmap (Map.fromListWithKey (\ k a b -> error $ "Multiple values for " ++ k ++ ":\n " ++ show a ++ "\n" ++ show b)) $ execWriterT $ do -- here <- liftIO getCurrentDirectory tell =<< control tell =<< changelog tell =<< rules tell =<< compat tell =<< copyright tell =<< sourceFormatFiles tell =<< watchFile tell =<< installs tell =<< dirs tell =<< init tell =<< logrotate tell =<< links tell =<< postinstFiles tell =<< postrmFiles tell =<< preinstFiles tell =<< prermFiles tell =<< intermediates sourceFormatFiles :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] sourceFormatFiles = do fmt <- lift $ use D.sourceFormat return $ [("debian/source/format", pack . ppShow $ fmt)] watchFile :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] watchFile = maybe [] (\ x -> [("debian/watch", x)]) <$> (lift $ use D.watch) intermediates :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] 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 $ use (D.atomSet)) where doAtom (D.Install b frm dst) mp = Map.insertWith (++) (pathf b) [pack (escapeDebianWildcards 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 $ use D.atomSet) where doAtom (D.InstallDir b dir) mp = Map.insertWith (++) (pathf b) [pack dir] mp doAtom _ mp = mp pathf name = "debian" show (ppPrint name) ++ ".dirs" init :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] init = (Map.toList . mapKeys pathf) <$> (lift $ 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 $ 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 $ use D.atomSet) where doAtom (D.Link b loc t) mp = Map.insertWith (++) (pathf b) [pack loc <> " " <> pack t] mp doAtom _ mp = mp pathf name = "debian" show (ppPrint name) ++ ".links" postinstFiles :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] postinstFiles = (Map.toList . mapKeys pathf) <$> (lift $ 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 $ 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 $ 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 $ 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 (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 $ 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 $ use D.control return [("debian/control", prettyText (controlFile d))] compat :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] 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 $ use (D.copyright) return $ maybe [] (\ x -> [("debian/copyright", prettyText x)]) copyrt instance Pretty (PP (PackageDescription -> IO CopyrightDescription)) where pPrint _ = text "" controlFile :: S.SourceDebDescription -> Control' String controlFile src = Control { unControl = (Paragraph ([Field ("Source", " " ++ (show . maybe empty ppPrint . view S.source $ src)), Field ("Maintainer", " " <> (ppShow . either (const maintainerOfLastResort) id . 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 . view B.package $ bin)), Field ("Architecture", " " ++ (show . maybe empty ppPrint . view B.architecture $ bin))] ++ mField "Multi-Arch" (view B.multiArch 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 (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 (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))] vcsField (S.VCSBrowser t) = Field ("Vcs-Browser", " " ++ unpack t) vcsField (S.VCSArch t) = Field ("Vcs-Arch", " " ++ unpack t) vcsField (S.VCSBzr t) = Field ("Vcs-Bzr", " " ++ unpack t) vcsField (S.VCSCvs t) = Field ("Vcs-Cvs", " " ++ unpack t) vcsField (S.VCSDarcs t) = Field ("Vcs-Darcs", " " ++ unpack t) vcsField (S.VCSGit t) = Field ("Vcs-Git", " " ++ unpack t) vcsField (S.VCSHg t) = Field ("Vcs-Hg", " " ++ unpack t) vcsField (S.VCSMtn t) = Field ("Vcs-Mtn", " " ++ unpack t) vcsField (S.VCSSvn t) = Field ("Vcs-Svn", " " ++ unpack t) xField (S.XField dests tag t) = Field (unpack ("X" <> showDests dests <> "-" <> tag), unpack (" " <> t)) showDests s = if member S.B s then "B" else "" <> if member S.S s then "S" else "" <> if member S.C s then "C" else "" relFields :: B.PackageRelations -> [Field' [Char]] relFields 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)] cabal-debian-4.31/src/Debian/Debianize/CopyrightDescription.hs0000644000000000000000000003142212565162075022477 0ustar0000000000000000-- | {-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances, OverloadedStrings, ScopedTypeVariables, TemplateHaskell, TupleSections, LambdaCase #-} module Debian.Debianize.CopyrightDescription ( CopyrightDescription(..) , FilesOrLicenseDescription(..) -- * Lenses , format , upstreamName , upstreamContact , upstreamSource , disclaimer , summaryComment , summaryLicense , summaryCopyright , filesAndLicenses , filesPattern , filesCopyright , filesLicense , filesLicenseText , filesComment , license , licenseText , comment -- * Builders , readCopyrightDescription , parseCopyrightDescription , defaultCopyrightDescription ) where import Data.Char (isSpace) import Data.Default (Default(def)) import Data.Either (lefts, rights) import Data.Generics (Data, Typeable) import Control.Lens.TH (makeLenses) import Data.List as List (dropWhileEnd, partition) import Data.Maybe.Extended (isJust, catMaybes, fromJust, fromMaybe, listToMaybe, nothingIf) import Data.Monoid ((<>), mempty) import Data.Text as Text (Text, pack, strip, unpack, null, lines, unlines, dropWhileEnd) import Debian.Control (Field'(Field), fieldValue, Paragraph'(Paragraph), Control'(Control, unControl), parseControl) import Debian.Debianize.Prelude (readFileMaybe) import Debian.Orphans () import Debian.Policy (License(..), readLicense, fromCabalLicense) import Debian.Pretty (prettyText, ppText) import Debug.Trace import qualified Distribution.License as Cabal (License(UnknownLicense)) import qualified Distribution.Package as Cabal #if MIN_VERSION_Cabal(1,20,0) import qualified Distribution.PackageDescription as Cabal (PackageDescription(licenseFiles, copyright, license, package, maintainer)) #else import qualified Distribution.PackageDescription as Cabal (PackageDescription(licenseFile, copyright, license, package, maintainer)) #endif import Network.URI (URI, parseURI) 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 -- special case is used to represeent the old style free format file - -- if the value is equal to newCopyrightDescription except for the -- field _summaryComment, the text in _summaryComment is the copyright -- file. data CopyrightDescription = CopyrightDescription { _format :: URI , _upstreamName :: Maybe Text , _upstreamContact :: Maybe Text , _upstreamSource :: Maybe Text , _disclaimer :: Maybe Text , _summaryComment :: Maybe Text , _summaryLicense :: Maybe (License, Maybe Text) , _summaryCopyright :: Maybe Text , _filesAndLicenses :: [FilesOrLicenseDescription] } deriving (Eq, Ord, Show, Data, Typeable) data FilesOrLicenseDescription = FilesDescription { _filesPattern :: FilePath , _filesCopyright :: Text , _filesLicense :: License , _filesLicenseText :: Maybe Text , _filesComment :: Maybe Text } | LicenseDescription { _license :: License , _licenseText :: Maybe Text , _comment :: Maybe Text } deriving (Eq, Ord, Show, Data, Typeable) instance Pretty CopyrightDescription where -- Special case encodes free format debian/copyright file pPrint x@(CopyrightDescription {_summaryComment = Just t}) | x {_summaryComment = Nothing} == def = text (List.dropWhileEnd isSpace (unpack t) <> "\n") pPrint x = pPrint . toControlFile $ x instance Default CopyrightDescription where def = CopyrightDescription { _format = fromJust $ parseURI "http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/" , _upstreamName = Nothing , _upstreamContact = Nothing , _upstreamSource = Nothing , _disclaimer = Nothing , _summaryComment = Nothing , _summaryLicense = Nothing , _summaryCopyright = Nothing , _filesAndLicenses = [] } -- | Read a 'CopyrightDescription' from the text one might obtain from -- a @debian/copyright@ file. readCopyrightDescription :: Text -> CopyrightDescription readCopyrightDescription t = case parseControl "debian/copyright" t of Left _e -> def { _summaryComment = Just t } Right ctl -> case parseCopyrightDescription (unControl ctl) of Just cpy -> cpy Nothing -> def { _summaryComment = Just t } -- | Try to parse a structured copyright file parseCopyrightDescription :: [Paragraph' Text] -> Maybe CopyrightDescription parseCopyrightDescription (hd : tl) = let (muri :: Either (Paragraph' Text) URI) = maybe (Left hd) Right (maybe Nothing (parseURI . unpack) (fieldValue "Format" hd)) in case (muri, map parseFilesOrLicense tl) of (Right uri, fnls) | all (either (const False) (const True)) fnls -> Just $ CopyrightDescription { _format = uri , _upstreamName = fieldValue "Upstream-Name" hd , _upstreamContact = fieldValue "Upstream-Contact" hd , _upstreamSource = fieldValue "Source" hd , _disclaimer = fieldValue "Disclaimer" hd , _summaryComment = fieldValue "Comment" hd , _summaryLicense = fmap readLicenseField (fieldValue "License" hd) , _summaryCopyright = Nothing -- fieldValue "Copyright" hd , _filesAndLicenses = rights fnls } (_, fnls) -> trace ("Not a parsable copyright file: " ++ show (lefts [muri] ++ lefts fnls)) Nothing parseCopyrightDescription [] = Nothing readLicenseField :: Text -> (License, Maybe Text) readLicenseField v | length lns > 1 = (readLicense firstLine, Just otherLines) | otherwise = (readLicense v, Nothing) where lns = Text.lines v firstLine = head lns otherLines = Text.unlines (tail lns) parseFilesOrLicense :: Paragraph' Text -> Either (Paragraph' Text) (FilesOrLicenseDescription) parseFilesOrLicense p = case (fieldValue "Files" p, fieldValue "Copyright" p, fieldValue "License" p) of (Just files, Just copyright, Just license) -> let (l,t) = readLicenseField license in Right $ FilesDescription { _filesPattern = unpack files , _filesCopyright = copyright , _filesLicense = l , _filesLicenseText = t , _filesComment = fieldValue "Comment" p } (Nothing, Nothing, Just license) -> let (l,t) = readLicenseField license in Right $ LicenseDescription { _license = l , _licenseText = t , _comment = fieldValue "Comment" p } _ -> Left p toControlFile :: CopyrightDescription -> Control' Text toControlFile d = Control ( Paragraph ( [ Field ("Format", (" " <> ppText (_format d))) ] ++ maybe [] (\x -> [Field ("Upstream-Name", " " <> x)]) (_upstreamName d) ++ maybe [] (\x -> [Field ("Upstream-Contact", " " <> x)]) (_upstreamContact d) ++ maybe [] (\x -> [Field ("Source", " " <> x)]) (_upstreamSource d) ++ maybe [] (\x -> [Field ("Disclaimer", " " <> x)]) (_disclaimer d) ++ maybe [] (\(x,t) -> [toLicenseField x t]) (_summaryLicense d) ++ maybe [] (\x -> [Field ("Copyright", " " <> x)]) (_summaryCopyright d) ++ maybe [] (\x -> [Field ("Comment", " " <> x)]) (_summaryComment d)) : map toParagraph (_filesAndLicenses d) ) toParagraph :: FilesOrLicenseDescription -> Paragraph' Text toParagraph fd@FilesDescription {} = Paragraph $ [ Field ("Files", " " <> pack (_filesPattern fd)) , Field ("Copyright", " " <> _filesCopyright fd) , toLicenseField (_filesLicense fd) (_filesLicenseText fd) ] ++ maybe [] (\ t -> [Field ("Comment", " " <> t)]) (_filesComment fd) toParagraph ld@LicenseDescription {} = Paragraph $ [ toLicenseField (_license ld) (_licenseText ld) ] ++ maybe [] (\ t -> [Field ("Comment", " " <> t)]) (_comment ld) toLicenseField :: License -> Maybe Text -> Field' Text toLicenseField l t = Field ("License", " " <> prettyText l <> maybe mempty (Text.pack "\n" <>) t) sourceDefaultFilesDescription :: Maybe Text -> License -> FilesOrLicenseDescription sourceDefaultFilesDescription copyrt license = FilesDescription { _filesPattern = "*" , _filesCopyright = fromMaybe "(No copyright field in cabal file)" copyrt , _filesLicense = license , _filesLicenseText = mempty , _filesComment = mempty } debianDefaultFilesDescription :: License -> FilesOrLicenseDescription debianDefaultFilesDescription license = FilesDescription { _filesPattern = "debian/*" , _filesCopyright = "held by the contributors mentioned in debian/changelog" , _filesLicense = license , _filesLicenseText = mempty , _filesComment = mempty } defaultLicenseDescriptions :: License -> [(FilePath, Maybe Text)] -> [FilesOrLicenseDescription] defaultLicenseDescriptions license = \case [] -> [] [(_, txt)] -> [LicenseDescription license txt Nothing] pairs -> map mkLicenseDescription pairs where mkLicenseDescription (path, txt) = LicenseDescription { _license = fromCabalLicense (Cabal.UnknownLicense path) , _licenseText = txt , _comment = mempty } -- | Infer a 'CopyrightDescription' from a Cabal package description. -- This will try to read any copyright files listed in the cabal -- configuration. Inputs include the license field from the cabal -- file, the contents of the license files mentioned there, and the -- provided @copyright0@ value. defaultCopyrightDescription :: Cabal.PackageDescription -> IO CopyrightDescription defaultCopyrightDescription pkgDesc = do #if MIN_VERSION_Cabal(1,20,0) let (debianCopyrightPath, otherLicensePaths) = partition (== "debian/copyright") (Cabal.licenseFiles pkgDesc) #else let (debianCopyrightPath, otherLicensePaths) = partition (== "debian/copyright") [Cabal.licenseFile pkgDesc] #endif license = fromCabalLicense $ Cabal.license pkgDesc pkgname = unPackageName . Cabal.pkgName . Cabal.package $ pkgDesc maintainer = Cabal.maintainer $ pkgDesc -- This is an @Nothing@ unless debian/copyright is (for some -- reason) mentioned in the cabal file. debianCopyrightText <- mapM readFileMaybe debianCopyrightPath >>= return . listToMaybe . catMaybes licenseCommentPairs <- mapM readFileMaybe otherLicensePaths >>= return . filter (isJust . snd) . zip otherLicensePaths return $ case debianCopyrightText of Just t -> def { _summaryComment = Just t } Nothing -> -- All we have is the name of the license let copyrt = fmap dots $ nothingIf (Text.null . strip) (pack (Cabal.copyright pkgDesc)) in def { _filesAndLicenses = [ sourceDefaultFilesDescription copyrt license, debianDefaultFilesDescription license ] ++ defaultLicenseDescriptions license licenseCommentPairs , _upstreamName = Just . pack $ pkgname , _upstreamSource = Just . pack $ "https://hackage.haskell.org/package/" ++ pkgname , _upstreamContact = nothingIf Text.null (pack maintainer) } {- -- We don't really have a way to associate licenses with -- file patterns, so we will just cover some simple cases, -- a single license, no license, etc. -- It is possible we might interpret the license file path -- as a license name, so I hang on to it here. return $ cabalToCopyrightDescription pkgDesc licenseComments (maybe def readCopyrightDescription debianCopyrightText) where cabalToCopyrightDescription :: Cabal.PackageDescription -> [Maybe Text] -> CopyrightDescription -> CopyrightDescription cabalToCopyrightDescription pkgDesc licenseComments copyright0 = let copyrt = fmap dots $ nothingIf (Text.null . strip) (pack (Cabal.copyright pkgDesc)) license = Cabal.license pkgDesc in copyright0 { _filesAndLicenses = map (\ comment -> FilesDescription { _filesPattern = "*" , _filesCopyright = fromMaybe (pack "(No copyright field in cabal file)") copyrt , _filesLicense = fromCabalLicense license , _filesComment = comment }) licenseComments } -} -- | Replace empty lines with single dots dots :: Text -> Text dots = Text.unlines . map (\ line -> if Text.null line then "." else line) . map (Text.dropWhileEnd isSpace) . Text.lines $(makeLenses ''CopyrightDescription) $(makeLenses ''FilesOrLicenseDescription) cabal-debian-4.31/src/Debian/Debianize/Finalize.hs0000644000000000000000000011410612565162075020065 0ustar0000000000000000-- | Compute the debianization of a cabal package. {-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances, OverloadedStrings, ScopedTypeVariables #-} module Debian.Debianize.Finalize ( debianize -- , finalizeDebianization -- external use deprecated - used in test script ) where import Control.Applicative ((<$>)) import Control.Lens hiding ((<.>)) import Control.Monad (unless, when) import Control.Monad as List (mapM_) import Control.Monad.State (get, modify) import Control.Monad.Trans (liftIO, MonadIO) import Data.ByteString.Lazy.UTF8 (fromString) import Data.Char (toLower) import Data.Digest.Pure.MD5 (md5) import Data.Function (on) import Data.List as List (filter, intercalate, map, nub, null, unlines, maximumBy) import Data.Map as Map (delete, elems, insertWith, lookup, Map, toList) import Data.Maybe (fromMaybe, isJust, fromJust) import Data.Monoid ((<>), mempty) import Data.Set as Set (difference, filter, fold, fromList, insert, map, null, Set, singleton, toList, union, unions) import Data.Set.Extra as Set (mapM_) import Data.Text as Text (intercalate, pack, Text, unlines, unpack) import Debian.Changes (ChangeLog(..), ChangeLogEntry(..)) import Debian.Debianize.BasicInfo (cabalFlagAssignments, compilerFlavor, verbosity) import qualified Debian.Debianize.BinaryDebDescription as B import Debian.Debianize.BuildDependencies (debianBuildDeps, debianBuildDepsIndep) import qualified Debian.Debianize.CabalInfo as A import Debian.Debianize.Changelog (dropFutureEntries) import qualified Debian.Debianize.DebInfo as D import Debian.Debianize.DebianName (debianName, debianNameBase) import Debian.Debianize.Goodies (backupAtoms, describe, execAtoms, serverAtoms, siteAtoms, watchAtom) import Debian.Debianize.InputDebian (dataTop, dataDest, inputChangeLog) import Debian.Debianize.Monad as Monad (CabalT, liftCabal) import Debian.Debianize.Prelude ((.?=)) import qualified Debian.Debianize.SourceDebDescription as S import Debian.Debianize.VersionSplits (DebBase(DebBase)) import Debian.Orphans () import Debian.Policy (getCurrentDebianUser, getDebhelperCompatLevel, haskellMaintainer, maintainerOfLastResort, PackageArchitectures(Any, All), PackagePriority(Extra), parseMaintainer, parseStandardsVersion, Section(..), SourceFormat(Native3)) import Debian.Pretty (PP(..), ppShow) import Debian.Relation (BinPkgName, BinPkgName(BinPkgName), Relation(Rel), Relations, SrcPkgName(SrcPkgName)) import qualified Debian.Relation as D (BinPkgName(BinPkgName), Relation(..)) import Debian.Release (parseReleaseName) import Debian.Time (getCurrentLocalRFC822Time) import qualified Debian.Version as V (buildDebianVersion, DebianVersion, parseDebianVersion, epoch, version, revision) import Distribution.Compiler (CompilerFlavor(GHC)) #if MIN_VERSION_Cabal(1,22,0) import Distribution.Compiler (CompilerFlavor(GHCJS)) #endif 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 System.FilePath ((<.>), (), makeRelative, splitFileName, takeDirectory, takeFileName) import System.IO (hPutStrLn, stderr) import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr(..)) import Text.PrettyPrint.HughesPJClass (Pretty(pPrint)) -- | @debianize customize@ initializes the CabalT state from the -- environment and the cabal package description in (and possibly the -- debian/changelog file) from the current directory, then runs -- @customize@ and finalizes the debianization so it is ready to be -- output. debianize :: (MonadIO m, Functor m) => CabalT m () -> CabalT m () debianize customize = do liftCabal inputChangeLog customize finalizeDebianization -- | Do some light IO and call finalizeDebianization. finalizeDebianization :: (MonadIO m, Functor m) => CabalT m () finalizeDebianization = do date <- liftIO getCurrentLocalRFC822Time currentUser <- liftIO getCurrentDebianUser debhelperCompat <- liftIO getDebhelperCompatLevel finalizeDebianization' date currentUser debhelperCompat vb <- use (A.debInfo . D.flags . verbosity) when (vb >= 3) (get >>= \ x -> liftIO (putStrLn ("\nFinalized Cabal Info: " ++ show x ++ "\n"))) either (\e -> liftIO $ hPutStrLn stderr ("WARNING: " ++ e)) (\_ -> return ()) =<< use (A.debInfo . D.control . S.maintainer) -- | Now that we know the build and data directories, we can expand -- some atoms into sets of simpler atoms which can eventually be -- turned into the files of the debianization. The original atoms are -- not removed from the list because they may contribute to the -- debianization in other ways, so be careful not to do this twice, -- this function is not idempotent. (Exported for use in unit tests.) -- FIXME: we should be able to run this without a PackageDescription, change -- paramter type to Maybe PackageDescription and propagate down thru code finalizeDebianization' :: (Monad m, Functor m) => String -> Maybe NameAddr -> Maybe Int -> CabalT m () finalizeDebianization' date currentUser debhelperCompat = do -- In reality, hcs must be a singleton or many things won't work. But some day... hc <- use (A.debInfo . D.flags . compilerFlavor) pkgDesc <- use A.packageDescription testsStatus <- use (A.debInfo . D.testsStatus) let testsExist = not $ List.null $ Cabal.testSuites pkgDesc case (testsExist, testsStatus) of (True, D.TestsRun) -> (A.debInfo . D.rulesSettings) %= (++ ["DEB_ENABLE_TESTS = yes"]) (True, D.TestsBuild) -> (A.debInfo . D.rulesSettings) %= (++ ["DEB_ENABLE_TESTS = yes", "DEB_BUILD_OPTIONS += nocheck"]) _ -> return () 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.compat) .?= debhelperCompat finalizeChangelog date currentUser finalizeControl currentUser finalizeRules -- T.license .?= Just (Cabal.license pkgDesc) expandAtoms -- Create the binary packages for the web sites, servers, backup packges, and other executables use (A.debInfo . D.executable) >>= List.mapM_ (cabalExecBinaryPackage . fst) . Map.toList use (A.debInfo . D.backups) >>= List.mapM_ (cabalExecBinaryPackage . fst) . Map.toList 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 <- 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. expandAtoms -- Turn atoms related to priority, section, and description into debianization elements -- finalizeDescriptions -- | Compute the final values of the BinaryDebDescription record -- description fields from the cabal descriptions and the values that -- have already been set. {- finalizeDescriptions :: (Monad m, Functor m) => CabalT m () finalizeDescriptions = use T.binaryPackages >>= List.mapM_ finalizeDescription finalizeDescription :: (Monad m, Functor m) => B.BinaryDebDescription -> CabalT m () finalizeDescription bdd = do let b = view B.package bdd cabDesc <- describe T.debianDescription .?= Just cabDesc -} -- | Construct the final Debian version number. -- Inputs: -- -- 1. --deb-version argument -- 2. --revision argument -- 3. cabal version number -- 4. latest version in debian/changelog -- -- The --deb-version argument overrides everything. debianVersion :: (Monad m, Functor m) => CabalT m V.DebianVersion debianVersion = do cabalName <- (pkgName . Cabal.package) <$> use A.packageDescription (cabalVersion :: V.DebianVersion) <- (V.parseDebianVersion . ppShow . pkgVersion . Cabal.package) <$> use A.packageDescription cabalEpoch <- debianEpoch cabalName fmt <- use (A.debInfo . D.sourceFormat) cabalRevision <- do x <- use (A.debInfo . D.revision) -- from the --revision option let y = case x of Nothing -> Nothing Just "" -> Nothing Just "-" -> Nothing Just ('-':r) -> Just r Just _ -> error "The --revision argument must start with a dash" return $ case fmt of Native3 -> y _ -> maybe (Just "1") (Just . max "1") y versionArg <- use (A.debInfo . D.debVersion) -- from the --deb-version option (debVersion :: 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 -> error ("Version from --deb-version (" ++ ppShow versionArg ++ ") is older than cabal version (" ++ ppShow cabalVersion ++ "), maybe you need to unpin this package?") _ | isJust versionArg -> return $ fromJust versionArg _ | isJust debVersion -> case (V.epoch (fromJust debVersion), V.parseDebianVersion (V.version (fromJust debVersion)), V.revision (fromJust debVersion)) of (debEpoch, debianVersion', (debianRevision :: Maybe String)) -> let finalEpoch = max debEpoch cabalEpoch finalVersion = max debianVersion' cabalVersion (finalRevision :: Maybe String) = maximumBy (compare `on` fmap V.parseDebianVersion) [debianRevision, cabalRevision] in return $ V.buildDebianVersion finalEpoch (ppShow finalVersion) finalRevision _ -> return $ V.buildDebianVersion cabalEpoch (ppShow cabalVersion) cabalRevision changelogVersion :: ChangeLog -> Maybe V.DebianVersion changelogVersion (ChangeLog (Entry {logVersion = x} : _)) = Just x changelogVersion _ = Nothing -- | 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 . view A.epochMap -- | Compute and return the debian source package name, based on the -- sourcePackageName if it was specified, and constructed from the -- cabal name otherwise. finalizeSourceName :: (Monad m, Functor m) => B.PackageType -> CabalT m () finalizeSourceName typ = do DebBase debName <- debianNameBase (A.debInfo . D.sourcePackageName) .?= Just (SrcPkgName (case typ of B.HaskellSource -> "haskell-" ++ debName B.Source -> debName _ -> error $ "finalizeSourceName: " ++ show typ)) -- | Try to compute a string for the the debian "Maintainer:" and -- "Uploaders:" fields using, in this order -- 1. the Debian Haskell Group, @pkg-haskell-maintainers\@lists.alioth.debian.org@, -- if --official is set -- 2. the maintainer explicitly specified using "Debian.Debianize.Monad.maintainer" -- 3. the maintainer field of the cabal package, but only if --official is not set, -- 4. the value returned by getDebianMaintainer, which looks in several environment variables, -- 5. the signature from the latest entry in debian/changelog, -- 6. the Debian Haskell Group, @pkg-haskell-maintainers\@lists.alioth.debian.org@ -- -- finalizeMaintainer :: Monad m => Maybe NameAddr -> CabalT m () finalizeMaintainer currentUser = do o <- use (A.debInfo . D.official) 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 <- use (A.debInfo . D.changelog) case log of Just (ChangeLog (entry : _)) -> case (parseMaintainer (logWho entry)) of Left _e -> return $ Nothing -- Just $ NameAddr (Just "Invalid signature in changelog") (show e) Right x -> return (Just x) _ -> return Nothing case o of True -> do (A.debInfo . D.control . S.maintainer) .= Right haskellMaintainer (A.debInfo . D.control . S.uploaders) %= whenEmpty (maybe [] (: []) currentUser) False -> do (A.debInfo . D.control . S.maintainer) %= either (\x -> maybe (Left x) Right maintainerOption) Right (A.debInfo . D.control . S.maintainer) %= either (\_ -> parseMaintainer cabalMaintainerString) Right (A.debInfo . D.control . S.maintainer) %= either (\_ -> parseMaintainer cabalMaintainerString') Right (A.debInfo . D.control . S.maintainer) %= either (\_ -> parseMaintainer cabalMaintainerString'') Right -- Sometimes the maintainer is just an email, if it matches the author's email we can use it (A.debInfo . D.control . S.maintainer) %= either (\e -> case parseMaintainer cabalAuthorString of Right x | nameAddr_addr x == cabalMaintainerString -> Right x Right _ -> Left e Left x -> Left x) Right -- Sometimes the maintainer is just an email, try combining it with the author's name (A.debInfo . D.control . S.maintainer) %= either (\e -> case parseMaintainer cabalAuthorString of Right (NameAddr {nameAddr_name = Just name}) -> parseMaintainer (name ++ " <" ++ cabalMaintainerString ++ ">") Right _ -> Left e Left x -> Left x) Right (A.debInfo . D.control . S.maintainer) %= either (\e -> maybe (Left e) Right currentUser) Right (A.debInfo . D.control . S.maintainer) %= either (\e -> maybe (Left e) Right changelogSignature) Right (A.debInfo . D.control . S.maintainer) %= either (\_ -> Left ("Unable to construct a debian maintainer, using default. Cabal maintainer strings tried:\n " ++ show cabalMaintainerString ++ ", " ++ show cabalMaintainerString' ++ ", " ++ show cabalMaintainerString'' ++ ", currentUser: " ++ show currentUser)) Right (A.debInfo . D.control . S.uploaders) %= whenEmpty uploadersOption -- | If l is the empty list return d, otherwise return l. whenEmpty :: [a] -> [a] -> [a] whenEmpty d [] = d whenEmpty _ l = l finalizeControl :: (Monad m, Functor m) => Maybe NameAddr -> CabalT m () finalizeControl currentUser = do finalizeMaintainer currentUser 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' -- control %= (\ y -> y { D.source = Just src, D.maintainer = Just maint }) -- | Make sure there is a changelog entry with the version number and -- source package name implied by the debianization. This means -- either adding an entry or modifying the latest entry (if its -- version number is the exact one in our debianization.) finalizeChangelog :: (Monad m, Functor m) => String -> Maybe NameAddr -> CabalT m () finalizeChangelog date currentUser = do finalizeMaintainer currentUser ver <- debianVersion src <- use (A.debInfo . D.sourcePackageName) debianUploaders <- use (A.debInfo . D.control . S.uploaders) debianMaintainer <- use (A.debInfo . D.control . S.maintainer) let nameToUse | (n:_) <- debianUploaders = Right n | otherwise = debianMaintainer -- 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" (A.debInfo . D.changelog) %= fixLog src ver cmts nameToUse msg where fixLog :: Maybe SrcPkgName -> V.DebianVersion -> Maybe [[Text]] -> Either String NameAddr -> Text -> Maybe ChangeLog -> Maybe ChangeLog -- Ensure that the package name is correct in the first log entry. fixLog src ver cmts _maint _ (Just (ChangeLog (entry : older))) | logVersion entry == ver = let entry' = entry { logPackage = show (pPrint (PP src)) , logComments = logComments entry ++ "\n" ++ (List.unlines $ List.map ((" * " <>) . List.intercalate "\n " . List.map unpack) (fromMaybe [] cmts)) } in Just (ChangeLog (entry' : older)) -- The newest log entry isn't exactly ver, build a new entry. fixLog src ver cmts maint msg log = let entry = Entry { logPackage = show (pPrint (PP src)) , logVersion = ver , logDists = [parseReleaseName "UNRELEASED"] , logUrgency = "low" , logComments = List.unlines $ List.map ((" * " <>) . List.intercalate "\n " . List.map unpack) (fromMaybe [[msg]] cmts) , logWho = either (\_ -> ppShow maintainerOfLastResort) ppShow maint , logDate = date } in -- Creating new log entry for version Just (ChangeLog (entry : maybe [] (\ (ChangeLog entries) -> entries) log)) -- | Convert the extraLibs field of the cabal build info into debian -- binary package names and make them dependendencies of the debian -- devel package (if there is one.) addExtraLibDependencies :: (Monad m, Functor m) => CompilerFlavor -> CabalT m () addExtraLibDependencies hc = do pkgDesc <- use A.packageDescription devName <- debianName B.Development hc 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 g pkgDesc libMap = concatMap (devDep libMap) (nub $ concatMap Cabal.extraLibs $ Cabal.allBuildInfo $ pkgDesc) devDep :: Map String Relations -> String -> Relations devDep libMap cab = maybe [[Rel (BinPkgName ("lib" ++ cab ++ "-dev")) Nothing Nothing]] id (Map.lookup cab libMap) -- | Applies a few settings to official packages (unless already set) checkOfficialSettings :: (Monad m, Functor m) => CompilerFlavor -> CabalT m () checkOfficialSettings flavor = 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 <- 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 <- 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 , S.VCSDarcs $ "http://darcs.debian.org/pkg-haskell/" <> pack src ]) putBuildDeps :: (Monad m, Functor m) => (Relations -> Relations) -> PackageDescription -> CabalT m () 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 -- | Filter out any relations that mention any of the bad package names. filterRelations :: [BinPkgName] -> Relations -> Relations filterRelations badNames orRels = List.filter (not . List.null) (List.map filterOrRelation orRels) where filterOrRelation :: [Relation] -> [Relation] filterOrRelation rels = List.filter (\ (Rel name _ _) -> not (elem name badNames)) rels cabalExecBinaryPackage :: Monad m => BinPkgName -> CabalT m () cabalExecBinaryPackage b = do (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 = zoom A.debInfo $ do edds <- use D.extraDevDeps zoom (D.binaryDebDescription b . B.relations) $ do when (typ == B.Development) $ do B.depends %= (edds ++) B.depends %= (anyrel "${shlibs:Depends}" : ) B.depends %= ([anyrel "${haskell:Depends}", anyrel "${misc:Depends}"] ++) B.recommends %= (anyrel "${haskell:Recommends}" : ) B.suggests %= (anyrel "${haskell:Suggests}" :) B.conflicts %= (anyrel "${haskell:Conflicts}" :) B.preDepends .= [] B.breaks .= [] B.builtUsing .= [] unless (typ == B.Documentation) $ do B.provides %= (anyrel "${haskell:Provides}" :) -- | 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 . 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) docSpecsParagraph :: (Monad m, Functor m) => CompilerFlavor -> CabalT m () 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 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 -- | This is the standard value for the Description field of a binary -- package control file stanza. desc :: Text desc = Text.intercalate "\n " ["${haskell:ShortDescription}${haskell:ShortBlurb}", "${haskell:LongDescription}", ".", "${haskell:Blurb}"] -- | Make sure all data and executable files are assigned to at least -- one binary package and make sure all binary packages are in the -- package list in the source deb description. If there are left over -- files, assign them to the packages returned by the -- utilsPackageNames lens, and make sure those packages are in the -- source deb description. makeUtilsPackage :: forall m. (Monad m, Functor m) => PackageDescription -> CompilerFlavor -> CabalT m () makeUtilsPackage pkgDesc hc = do -- Files the cabal package expects to be installed -- Files that are already assigned to any binary deb installedDataMap <- Set.fold (\ x r -> case x of 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 <$> use (A.debInfo . D.atomSet) :: CabalT m (Map BinPkgName (Set String)) -- The names of cabal executables that go into eponymous debs 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) prefixPath <- dataTop let dataFilePaths = Set.fromList (zip (List.map (prefixPath ) (Cabal.dataFiles pkgDesc)) (Cabal.dataFiles pkgDesc)) :: Set (FilePath, FilePath) execFilePaths = Set.map Cabal.exeName (Set.filter (Cabal.buildable . Cabal.buildInfo) (Set.fromList (Cabal.executables pkgDesc))) :: Set FilePath let availableData = Set.union installedData dataFilePaths availableExec = Set.union installedExec execFilePaths use (A.debInfo . D.utilsPackageNameBase) >>= \ name -> case name of Nothing -> debianName B.Utilities hc >>= \ (BinPkgName name') -> (A.debInfo . D.utilsPackageNameBase) .= Just name' _ -> return () b <- debianName B.Utilities hc -- Files that are installed into packages other than the utils packages let installedDataOther = Set.map (\ a -> (a, a)) $ Set.unions $ Map.elems $ Map.delete b installedDataMap installedExecOther = Set.union insExecPkg $ Set.unions $ Map.elems $ Map.delete b installedExecMap -- Files that will be in utils packages let utilsData = Set.difference availableData installedDataOther utilsExec = Set.difference availableExec installedExecOther -- Files that still need to be assigned to the utils packages let utilsDataMissing = Set.difference utilsData installedData 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 -- This is really for all binary debs except the libraries - I'm not sure why (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 Set.mapM_ (\ name -> (A.debInfo . D.atomSet) %= (Set.insert $ D.InstallCabalExec b name "usr/bin")) utilsExecMissing where ename i = case D.sourceDir i of (Nothing) -> D.execName i (Just s) -> s D.execName i expandAtoms :: Monad m => CabalT m () expandAtoms = 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 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" #endif _ -> error $ "Unexpected compiler: " ++ show hc) dDest <- dataDest expandApacheSites expandInstallCabalExecs builddir expandInstallCabalExecTo builddir expandInstallData dDest expandInstallTo expandFile expandWebsite expandServer expandBackups expandExecutable where expandApacheSites :: Monad m => CabalT m () expandApacheSites = do mp <- get >>= return . view (A.debInfo . D.apacheSite) List.mapM_ expandApacheSite (Map.toList mp) where expandApacheSite (b, (dom, log, text)) = do (A.debInfo . D.atomSet) %= (Set.insert $ D.Link b ("/etc/apache2/sites-available/" ++ dom) ("/etc/apache2/sites-enabled/" ++ dom)) (A.debInfo . D.atomSet) %= (Set.insert $ D.InstallDir b log) (A.debInfo . D.atomSet) %= (Set.insert $ D.File b ("/etc/apache2/sites-available" dom) text) -- Turn A.InstallCabalExec into A.Install expandInstallCabalExecs :: Monad m => FilePath -> CabalT m () expandInstallCabalExecs builddir = do 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) #if MIN_VERSION_Cabal(1,22,0) -- A GHCJS executable is a directory with files, copy them -- all into place. doAtom GHCJS (D.InstallCabalExec b name dest) = (A.debInfo . D.rulesFragments) %= Set.insert (Text.unlines [ pack ("binary-fixup" ppShow b) <> "::" , pack ("\t(cd " <> builddir name <> " && find " <> name <.> "jsexe" <> " -type f) |\\\n" <> "\t while read i; do install -Dp " <> builddir name "$$i debian" ppShow b makeRelative "/" dest "$$i; done\n") ]) #endif doAtom _ _ = return () -- Turn A.InstallCabalExecTo into a make rule expandInstallCabalExecTo :: Monad m => FilePath -> CabalT m () expandInstallCabalExecTo builddir = do 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) %= Set.insert (Text.unlines [ pack ("binary-fixup" ppShow b) <> "::" , "\tinstall -Dps " <> pack (builddir name name) <> " " <> pack ("debian" ppShow b makeRelative "/" dest) ]) doAtom hc (D.InstallCabalExecTo b name dest) = error $ "expandInstallCabalExecTo " ++ show hc ++ " " ++ show (D.InstallCabalExecTo b name dest) doAtom _ _ = return () -- Turn A.InstallData into either an Install or an InstallTo expandInstallData :: Monad m => FilePath -> CabalT m () expandInstallData dDest = use (A.debInfo . D.atomSet) >>= List.mapM_ doAtom . Set.toList where doAtom :: Monad m => D.Atom -> CabalT m () 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 = use (A.debInfo . D.atomSet) >>= List.mapM_ doAtom . Set.toList where doAtom :: Monad m => D.Atom -> CabalT m () doAtom (D.InstallTo b src dest) = (A.debInfo . D.rulesFragments) %= Set.insert (Text.unlines [ pack ("binary-fixup" ppShow b) <> "::" , "\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 = 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) %= Set.insert (tmpPath, text) (A.debInfo . D.atomSet) %= (Set.insert $ D.Install b tmpPath destDir') doAtom _ = return () expandWebsite :: Monad m => CabalT m () expandWebsite = do mp <- get >>= return . view (A.debInfo . D.website) pkgDesc <- use A.packageDescription List.mapM_ (\ (b, site) -> modify (siteAtoms pkgDesc b site)) (Map.toList mp) expandServer :: Monad m => CabalT m () expandServer = do mp <- get >>= return . view (A.debInfo . D.serverInfo) pkgDesc <- use A.packageDescription List.mapM_ (\ (b, x) -> modify (serverAtoms pkgDesc b x False)) (Map.toList mp) expandBackups :: Monad m => CabalT m () expandBackups = do mp <- get >>= return . view (A.debInfo . D.backups) List.mapM_ (\ (b, name) -> modify (backupAtoms b name)) (Map.toList mp) expandExecutable :: Monad m => CabalT m () expandExecutable = 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 <- 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) <$> 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"]) data Dependency_ = BuildDepends Dependency | BuildTools Dependency | PkgConfigDepends Dependency | ExtraLibs Relations deriving (Eq, Show) anyrel :: String -> [D.Relation] anyrel x = anyrel' (D.BinPkgName x) anyrel' :: D.BinPkgName -> [D.Relation] anyrel' x = [D.Rel x Nothing Nothing] -- Lifted from Distribution.Simple.Setup, since it's not exported. flagList :: String -> [(FlagName, Bool)] flagList = List.map tagWithValue . words where tagWithValue ('-':name) = (FlagName (List.map toLower name), False) tagWithValue name = (FlagName (List.map toLower name), True) flagString :: [(FlagName, Bool)] -> String flagString = List.intercalate " " . List.map (\ (FlagName s, sense) -> "-f" ++ (if sense then "" else "-") ++ s) cabal-debian-4.31/src/Debian/Debianize/BuildDependencies.hs0000644000000000000000000005303012565162075021670 0ustar0000000000000000-- | Compute the debianization of a cabal package. {-# LANGUAGE CPP, OverloadedStrings, ScopedTypeVariables, TupleSections #-} module Debian.Debianize.BuildDependencies ( debianBuildDeps , debianBuildDepsIndep ) where import Control.Applicative ((<$>)) import Control.Lens import Control.Monad.State (MonadState(get)) import Data.Char (isSpace, toLower) import Data.Function (on) import Data.List as List (filter, groupBy, map, minimumBy, nub, sortBy) import Data.Map as Map (lookup, Map) import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing) import Data.Set as Set (empty, fold, fromList, map, member, Set, singleton, toList, union) import Data.Version (showVersion, Version) import Debian.Debianize.BasicInfo (buildEnv, compilerFlavor, EnvSet(dependOS)) import Debian.Debianize.Bundled (builtIn) import qualified Debian.Debianize.DebInfo as D import Debian.Debianize.DebianName (mkPkgName, mkPkgName') import Debian.Debianize.Monad as Monad (CabalInfo, CabalT) import qualified Debian.Debianize.BinaryDebDescription as B import qualified Debian.Debianize.CabalInfo as A import qualified Debian.Debianize.SourceDebDescription as S import Debian.Debianize.VersionSplits (packageRangesFromVersionSplits) import Debian.GHC (compilerPackageName) import Debian.Orphans () import Debian.Relation (BinPkgName(..), checkVersionReq, Relation(..), Relations) import qualified Debian.Relation as D (BinPkgName(BinPkgName), Relation(..), Relations, VersionReq(EEQ, GRE, LTE, SGR, SLT)) import Debian.Version (DebianVersion, parseDebianVersion) import Distribution.Compiler (CompilerFlavor(..)) import Distribution.Package (Dependency(..), PackageName(PackageName)) import Distribution.PackageDescription (PackageDescription) import Distribution.PackageDescription as Cabal (BuildInfo(..), BuildInfo(buildTools, extraLibs, pkgconfigDepends), Library(..), Executable(..), TestSuite(..)) import qualified Distribution.PackageDescription as Cabal (PackageDescription(library, 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 System.Directory (findExecutable) import System.Exit (ExitCode(ExitSuccess)) import System.IO.Unsafe (unsafePerformIO) import System.Process (readProcessWithExitCode) data Dependency_ = BuildDepends Dependency | BuildTools Dependency | PkgConfigDepends Dependency | ExtraLibs Relations deriving (Eq, Show) -- | Naive conversion of Cabal build dependencies to Debian -- dependencies will usually result in a self dependency, due to the -- fact that a Cabal executable often depends on the associated -- library to build. Due to the fact that Debian build dependencies -- are global to the package, this results in unwanted self -- dependencies, which usually need to be filtered out. -- Unfortunately, some Debian packages actually do depend on an -- earlier version of themselves to build (e.g. most compilers.) So a -- command line option is probably necessary. -- -- selfDependency :: PackageIdentifier -> Dependency_ -> Bool -- selfDependency pkgId (BuildDepends (Dependency name _)) = name == pkgName pkgId -- selfDependency _ _ = False unboxDependency :: Dependency_ -> Maybe Dependency unboxDependency (BuildDepends d) = Just d unboxDependency (BuildTools d) = Just d unboxDependency (PkgConfigDepends d) = Just d unboxDependency (ExtraLibs _) = Nothing -- Dependency (PackageName d) anyVersion -- |Debian packages don't have per binary package build dependencies, -- so we just gather them all up here. allBuildDepends :: Monad m => [BuildInfo] -> CabalT m [Dependency_] allBuildDepends buildInfos = allBuildDepends' (mergeCabalDependencies $ concatMap Cabal.targetBuildDepends buildInfos) (mergeCabalDependencies $ concatMap buildTools buildInfos) (mergeCabalDependencies $ concatMap pkgconfigDepends buildInfos) (concatMap extraLibs buildInfos) >>= return {- . List.filter (not . selfDependency (Cabal.package pkgDesc)) -} where allBuildDepends' :: Monad m => [Dependency] -> [Dependency] -> [Dependency] -> [String] -> CabalT m [Dependency_] allBuildDepends' buildDepends' buildTools' pkgconfigDepends' extraLibs' = do atoms <- get return $ nub $ List.map BuildDepends buildDepends' ++ List.map BuildTools buildTools' ++ List.map PkgConfigDepends pkgconfigDepends' ++ [ExtraLibs (fixDeps atoms extraLibs')] fixDeps :: CabalInfo -> [String] -> Relations fixDeps atoms xs = concatMap (\ cab -> fromMaybe [[D.Rel (D.BinPkgName ("lib" ++ List.map toLower cab ++ "-dev")) Nothing Nothing]] (Map.lookup cab (view (A.debInfo . D.extraLibMap) atoms))) xs -- | Take the intersection of all the dependencies on a given package name mergeCabalDependencies :: [Dependency] -> [Dependency] mergeCabalDependencies = List.map (foldl1 (\ (Dependency name range1) (Dependency _ range2) -> Dependency name (intersectVersionRanges range1 range2))) . groupBy ((==) `on` dependencyPackage) . sortBy (compare `on` dependencyPackage) where dependencyPackage (Dependency x _) = x -- The haskell-cdbs package contains the hlibrary.mk file with -- the rules for building haskell packages. debianBuildDeps :: (Monad m, Functor m) => PackageDescription -> CabalT m D.Relations debianBuildDeps pkgDesc = do hc <- use (A.debInfo . D.flags . compilerFlavor) let hcs = singleton hc -- vestigial let hcTypePairsLibs = fold union empty $ Set.map (\ hc' -> Set.map (hc',) $ hcPackageTypesLibs hc') hcs let hcTypePairsBins = fold union empty $ Set.map (\ hc' -> Set.map (hc',) $ hcPackageTypesBins hc') hcs let hcTypePairsTests = fold union empty $ Set.map (\ hc' -> Set.map (hc',) $ hcPackageTypesTests hc') hcs libDeps <- allBuildDepends (maybe [] (return . libBuildInfo) (Cabal.library pkgDesc)) binDeps <- allBuildDepends (List.map buildInfo (Cabal.executables pkgDesc)) testDeps <- allBuildDepends (List.map testBuildInfo (Cabal.testSuites pkgDesc)) testsStatus <- use (A.debInfo . D.testsStatus) cDeps <- nub . concat . concat <$> sequence [ mapM (buildDependencies hcTypePairsLibs) libDeps , mapM (buildDependencies hcTypePairsBins) binDeps , mapM (buildDependencies hcTypePairsTests) (if testsStatus /= D.TestsDisable then testDeps else []) ] 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"] ++ (if member GHC hcs then [anyrel' (compilerPackageName GHC B.Development)] ++ if prof then [anyrel' (compilerPackageName GHC B.Profiling)] else [] else []) ++ #if MIN_VERSION_Cabal(1,22,0) (if member GHCJS hcs then [anyrel "ghcjs"] else []) ++ #endif bDeps ++ cDeps filterMissing xs where hcPackageTypesLibs :: CompilerFlavor -> Set B.PackageType hcPackageTypesLibs GHC = fromList [B.Development, B.Profiling] #if MIN_VERSION_Cabal(1,22,0) hcPackageTypesLibs GHCJS = fromList [B.Development] #endif hcPackageTypesLibs hc = error $ "Unsupported compiler flavor: " ++ show hc -- No point in installing profiling packages for the dependencies -- of binaries and test suites hcPackageTypesBins :: CompilerFlavor -> Set B.PackageType hcPackageTypesBins _ = singleton B.Development hcPackageTypesTests :: CompilerFlavor -> Set B.PackageType hcPackageTypesTests _ = singleton B.Development debianBuildDepsIndep :: (Monad m, Functor m) => PackageDescription -> CabalT m D.Relations debianBuildDepsIndep pkgDesc = do hc <- use (A.debInfo . D.flags . compilerFlavor) let hcs = singleton hc -- vestigial doc <- not <$> use (A.debInfo . D.noDocumentationLibrary) bDeps <- use (A.debInfo . D.control . S.buildDependsIndep) libDeps <- allBuildDepends (maybe [] (return . libBuildInfo) (Cabal.library pkgDesc)) cDeps <- mapM docDependencies libDeps let xs = nub $ if doc && isJust (Cabal.library pkgDesc) then (if member GHC hcs then [anyrel' (compilerPackageName GHC B.Documentation)] else []) ++ #if MIN_VERSION_Cabal(1,22,0) (if member GHCJS hcs then [anyrel "ghcjs"] else []) ++ #endif bDeps ++ concat cDeps else [] filterMissing xs -- | The documentation dependencies for a package include the -- documentation package for any libraries which are build -- dependencies, so we have use to all the cross references. docDependencies :: (Monad m, Functor m) => Dependency_ -> CabalT m D.Relations docDependencies (BuildDepends (Dependency name ranges)) = do hc <- use (A.debInfo . D.flags . compilerFlavor) let hcs = singleton hc -- vestigial omitProfDeps <- use (A.debInfo . D.omitProfVersionDeps) concat <$> mapM (\ hc' -> dependencies hc' B.Documentation name ranges omitProfDeps) (toList hcs) docDependencies _ = return [] -- | The Debian build dependencies for a package include the profiling -- libraries and the documentation packages, used for creating cross -- references. Also the packages associated with extra libraries. buildDependencies :: (Monad m, Functor m) => Set (CompilerFlavor, B.PackageType) -> Dependency_ -> CabalT m D.Relations buildDependencies hcTypePairs (BuildDepends (Dependency name ranges)) = use (A.debInfo . D.omitProfVersionDeps) >>= \ omitProfDeps -> concat <$> mapM (\ (hc, typ) -> dependencies hc typ name ranges omitProfDeps) (toList hcTypePairs) buildDependencies _ dep@(ExtraLibs _) = 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 . view (A.debInfo . D.execMap) return $ concat $ adapt mp dep Nothing -> return [] adapt :: Map.Map String Relations -> Dependency_ -> [Relations] adapt mp (PkgConfigDepends (Dependency (PackageName pkg) _)) = maybe (aptFile pkg) (: []) (Map.lookup pkg mp) adapt mp (BuildTools (Dependency (PackageName pkg) _)) = maybe (aptFile pkg) (: []) (Map.lookup pkg mp) adapt _flags (ExtraLibs x) = [x] adapt _flags (BuildDepends (Dependency (PackageName pkg) _)) = [[[D.Rel (D.BinPkgName pkg) Nothing Nothing]]] -- There are three reasons this may not work, or may work -- incorrectly: (1) the build environment may be a different -- distribution than the parent environment (the environment the -- autobuilder was run from), so the packages in that -- environment might have different names, (2) the package -- we are looking for may not be installed in the parent -- environment, and (3) the apt-file executable is not installed. aptFile :: String -> [Relations] -- Maybe would probably be more correct aptFile pkg = unsafePerformIO $ findExecutable "apt-file" >>= aptFile' where aptFile' Nothing = error "The apt-file executable could not be found." aptFile' (Just aptfile) = do ret <- readProcessWithExitCode aptfile ["-l", "search", pkg ++ ".pc"] "" return $ case ret of (ExitSuccess, out, _) -> case takeWhile (not . isSpace) out of "" -> error $ "Unable to locate a debian package containing the build tool " ++ pkg ++ ", try using --exec-map " ++ pkg ++ "= or execMap " ++ show pkg ++ " [[Rel (BinPkgName \"\") Nothing Nothing]]" s -> [[[D.Rel (D.BinPkgName s) Nothing Nothing]]] _ -> [] anyrel :: String -> [D.Relation] anyrel x = anyrel' (D.BinPkgName x) anyrel' :: D.BinPkgName -> [D.Relation] anyrel' x = [D.Rel x Nothing Nothing] -- | Turn a cabal dependency into debian dependencies. The result -- needs to correspond to a single debian package to be installed, -- so we will return just an OrRelation. dependencies :: Monad m => CompilerFlavor -> B.PackageType -> PackageName -> VersionRange -> Bool -> CabalT m Relations dependencies hc typ name cabalRange omitProfVersionDeps = 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 -- by a version range over these "or" dependences. let alts :: [(BinPkgName, VersionRange)] alts = case Map.lookup name nameMap of -- If there are no splits for this package just -- return the single dependency for the package. Nothing -> [(mkPkgName hc name typ, cabalRange')] -- If there are splits create a list of (debian package name, VersionRange) pairs Just splits' -> List.map (\ (n, r) -> (mkPkgName' hc typ n, r)) (packageRangesFromVersionSplits splits') mapM convert alts >>= mapM (doBundled typ name hc) . convert' . canonical . Or . catMaybes where convert (dname, range) = case isNoVersion range''' of True -> return Nothing False -> foldVersionRange' (return $ Rel' (D.Rel dname Nothing Nothing)) (\ v -> debianVersion' name v >>= \ dv -> return $ Rel' (D.Rel dname (Just (D.EEQ dv)) Nothing)) (\ v -> debianVersion' name v >>= \ dv -> return $ Rel' (D.Rel dname (Just (D.SGR dv)) Nothing)) (\ v -> debianVersion' name v >>= \ dv -> return $ Rel' (D.Rel dname (Just (D.SLT dv)) Nothing)) (\ v -> debianVersion' name v >>= \ dv -> return $ Rel' (D.Rel dname (Just (D.GRE dv)) Nothing)) (\ v -> debianVersion' name v >>= \ dv -> return $ Rel' (D.Rel dname (Just (D.LTE dv)) Nothing)) (\ x y -> debianVersion' name x >>= \ dvx -> debianVersion' name y >>= \ dvy -> return $ And [Rel' (D.Rel dname (Just (D.GRE dvx)) Nothing), Rel' (D.Rel dname (Just (D.SLT dvy)) Nothing)]) (\ x y -> x >>= \ x' -> y >>= \ y' -> return $ Or [x', y']) (\ x y -> x >>= \ x' -> y >>= \ y' -> return $ And [x', y']) id range''' >>= return . Just where -- Choose the simpler of the two range''' = canon (simpler range' range'') -- Unrestrict the range for versions that we know don't exist for this debian package range'' = canon (unionVersionRanges range' (invertVersionRange range)) -- Restrict the range to the versions specified for this debian package range' = intersectVersionRanges cabalRange' range -- When we see a cabal equals dependency we need to turn it into -- a wildcard because the resulting debian version numbers have -- various suffixes added. cabalRange' | typ `elem` noVersionPackageType = anyVersion | otherwise = foldVersionRange' anyVersion withinVersion -- <- Here we are turning equals into wildcard laterVersion earlierVersion orLaterVersion orEarlierVersion (\ lb ub -> intersectVersionRanges (orLaterVersion lb) (earlierVersion ub)) unionVersionRanges intersectVersionRanges id cabalRange noVersionPackageType = (if omitProfVersionDeps then [B.Profiling] else []) ++ [B.Documentation] simpler v1 v2 = minimumBy (compare `on` (length . asVersionIntervals)) [v1, v2] -- Simplify a VersionRange canon = fromVersionIntervals . toVersionIntervals -- | If a package is bundled with the compiler we make the -- compiler a substitute for that package. If we were to -- specify the virtual package (e.g. libghc-base-dev) we would -- have to make sure not to specify a version number. doBundled :: Monad m => B.PackageType -> PackageName -> CompilerFlavor -> [D.Relation] -> CabalT m [D.Relation] doBundled typ name hc rels = mapM doRel rels >>= return . concat where -- If a library is built into the compiler, this is the debian -- package name the compiler will conflict with. comp = D.Rel (compilerPackageName hc typ) Nothing Nothing doRel :: Monad m => D.Relation -> CabalT m [D.Relation] doRel rel@(D.Rel dname req _) = do -- 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? let pver = maybe Nothing (Just . debianVersion'' atoms name) (builtIn splits hc root name) -- The name this library would have if it was in the compiler conflicts list. let naiveDebianName = mkPkgName hc name typ -- The compiler should appear in the build dependency -- if it provides a suitable version of the library, -- or if it conflicts with all versions of the -- library (which, if pver is Nothing, will certainly -- result in an error which needs to be corrected in -- the packaging.) let compilerDependency = if isJust pver && (checkVersionReq req pver || (dname == naiveDebianName && conflictsWithHC naiveDebianName)) then [comp] else [] -- The library package can satisfy the dependency if -- the compiler doesn't provide a version, or if the -- compiler doesn't conflict with the package's -- debian name. let libraryDependency = if isNothing pver || dname /= naiveDebianName || not (conflictsWithHC naiveDebianName) then [rel] else [] -- Is the version number in the library dependency newer than -- the compiler version? If so it should appear to its left, -- otherwise to its right. return $ case req of Just (D.SLT lver) | Just lver < pver -> compilerDependency ++ libraryDependency Just (D.LTE lver) | Just lver < pver -> compilerDependency ++ libraryDependency Just (D.EEQ lver) | Just lver < pver -> compilerDependency ++ libraryDependency _ -> libraryDependency ++ compilerDependency -- FIXME: we are assuming here that ghc conflicts with all the -- library packages it provides but it no longer conflicts with -- libghc-cabal-dev. We can now check these conflicts using the -- new functions in Bundled. conflictsWithHC (BinPkgName "libghc-cabal-dev") = False conflictsWithHC (BinPkgName "libghc-cabal-prof") = False conflictsWithHC (BinPkgName "libghc-cabal-doc") = False conflictsWithHC _ = True {- doBundled :: MonadIO m => B.PackageType -- Documentation, Profiling, Development... -> PackageName -- Cabal package name -> [D.Relation] -- Original set of debian dependencies -> CabalT m [D.Relation] -- Modified debian dependencies accounting for the packages the compiler provides doBundled hc typ name rels = concat <$> mapM doRel rels where doRel :: MonadIO m => D.Relation -> CabalT m [D.Relation] doRel rel@(D.Rel dname req _) = do 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 (view A.epochMap atoms)) ++ showVersion v) debianVersion'' :: CabalInfo -> PackageName -> Version -> DebianVersion 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 convert' :: Rels a -> [[a]] convert' = List.map (List.map unRel . unOr) . unAnd . canonical -- | return and of ors of rel canonical :: Rels a -> Rels a canonical (Rel' rel) = And [Or [Rel' rel]] canonical (And rels) = And $ concatMap (unAnd . canonical) rels canonical (Or rels) = And . List.map Or $ sequence $ List.map (concat . List.map unOr . unAnd . canonical) $ rels filterMissing :: Monad m => [[Relation]] -> CabalT m [[Relation]] filterMissing rels = get >>= \ atoms -> return $ List.filter (/= []) (List.map (List.filter (\ (Rel name _ _) -> not (Set.member name (view (A.debInfo . D.missingDependencies) atoms)))) rels) cabal-debian-4.31/src/Distribution/0000755000000000000000000000000012565162075015370 5ustar0000000000000000cabal-debian-4.31/src/Distribution/Version/0000755000000000000000000000000012565162075017015 5ustar0000000000000000cabal-debian-4.31/src/Distribution/Version/Invert.hs0000644000000000000000000000414712565162075020626 0ustar0000000000000000{-# OPTIONS_GHC -Wall #-} module Distribution.Version.Invert ( invertVersionRange , invertVersionIntervals ) where import Distribution.Version (Version(Version, versionBranch, versionTags), VersionRange, fromVersionIntervals, asVersionIntervals, mkVersionIntervals, LowerBound(LowerBound), UpperBound(UpperBound, NoUpperBound), Bound(InclusiveBound, ExclusiveBound)) -- | This function belongs in Cabal, see http://hackage.haskell.org/trac/hackage/ticket/935. invertVersionRange :: VersionRange -> VersionRange invertVersionRange = fromVersionIntervals . maybe (error "invertVersionRange") id . mkVersionIntervals . invertVersionIntervals . asVersionIntervals invertVersionIntervals :: [(LowerBound, UpperBound)] -> [(LowerBound, UpperBound)] invertVersionIntervals xs = case xs of [] -> [(lb0, NoUpperBound)] ((LowerBound (Version {versionBranch = [0], versionTags = []}) InclusiveBound, ub) : more) -> invertVersionIntervals' ub more ((lb, ub) : more) -> (lb0, invertLowerBound lb) : invertVersionIntervals' ub more where invertVersionIntervals' :: UpperBound -> [(LowerBound, UpperBound)] -> [(LowerBound, UpperBound)] invertVersionIntervals' NoUpperBound [] = [] invertVersionIntervals' ub0 [] = [(invertUpperBound ub0, NoUpperBound)] invertVersionIntervals' ub0 [(lb, NoUpperBound)] = [(invertUpperBound ub0, invertLowerBound lb)] invertVersionIntervals' ub0 ((lb, ub1) : more) = (invertUpperBound ub0, invertLowerBound lb) : invertVersionIntervals' ub1 more invertLowerBound :: LowerBound -> UpperBound invertLowerBound (LowerBound v b) = UpperBound v (invertBound b) invertUpperBound :: UpperBound -> LowerBound invertUpperBound (UpperBound v b) = LowerBound v (invertBound b) invertUpperBound NoUpperBound = error "NoUpperBound: unexpected" invertBound :: Bound -> Bound invertBound ExclusiveBound = InclusiveBound invertBound InclusiveBound = ExclusiveBound lb0 :: LowerBound lb0 = LowerBound (Version {versionBranch = [0], versionTags = []}) InclusiveBound