packages feed

cabal-debian 4.15.2 → 4.17.3

raw patch · 25 files changed

+520/−363 lines, 25 filesdep ~debian

Dependency ranges changed: debian

Files

CabalDebian.hs view
@@ -6,9 +6,8 @@ -- function directly, many sophisticated configuration options cannot -- be accessed using the command line interface. -import Control.Monad.State (get) import Control.Monad.Trans (MonadIO, liftIO)-import Data.Lens.Lazy (getL)+import Data.Lens.Lazy (access) import Data.List as List (unlines) import Debian.Debianize.Details (debianDefaultAtoms) import Debian.Debianize.Finalize (debianization)@@ -17,22 +16,24 @@ import Debian.Debianize.Output (doDebianizeAction) import Debian.Debianize.SubstVars (substvars) import Debian.Debianize.Types.Atoms (DebAction(Debianize, SubstVar, Usage), EnvSet(EnvSet), debAction, newAtoms)-import Distribution.Compiler (CompilerFlavor(GHC)) import Prelude hiding (unlines, writeFile, init) import System.Console.GetOpt (OptDescr, usageInfo) import System.Environment (getProgName)  main :: IO ()-main = cabalDebianMain GHC debianDefaultAtoms+main = cabalDebianMain debianDefaultAtoms  -- | The main function for the cabal-debian executable.-cabalDebianMain :: (MonadIO m, Functor m) => CompilerFlavor -> DebT m () -> m ()-cabalDebianMain hc init =+cabalDebianMain :: (MonadIO m, Functor m) => DebT m () -> m ()+cabalDebianMain init =     -- This picks up the options required to decide what action we are     -- taking.  Much of this will be repeated in the call to debianize.-    newAtoms hc >>= \ atoms ->-    evalDebT (init >> compileEnvironmentArgs >> compileCommandlineArgs >>-              get >>= return . getL debAction >>= finish) atoms+    do atoms <- newAtoms+       evalDebT (do init+                    compileEnvironmentArgs+                    compileCommandlineArgs+                    action <- access debAction+                    finish action) atoms     where       envset = EnvSet "/" "/" "/"       finish :: forall m. (MonadIO m, Functor m) => DebAction -> DebT m ()
Tests.hs view
@@ -9,7 +9,7 @@ import Data.Algorithm.Diff.Context (contextDiff) import Data.Algorithm.Diff.Pretty (prettyDiff) import Data.Function (on)-import Data.Lens.Lazy (access, getL)+import Data.Lens.Lazy (access, getL, setL) import Data.List (sortBy) import Data.Map as Map (differenceWithKey, intersectionWithKey) import qualified Data.Map as Map (elems, Map, toList)@@ -59,10 +59,10 @@  -- | Force the compiler version to 7.6 to get predictable outputs testAtoms :: IO Atoms-testAtoms = ghc763 <$> T.newAtoms GHC+testAtoms = ghc763 <$> T.newAtoms     where       ghc763 :: Atoms -> Atoms-      ghc763 atoms = atoms+      ghc763 atoms = setL T.compilerFlavors (singleton GHC) atoms {- #if MIN_VERSION_Cabal(1,21,0)           let CompilerId flavor version _ = getL ghcVersion_ atoms in@@ -498,7 +498,7 @@                  assertEqual label [] diff)     where       customize old level standards =-          do T.utilsPackageNames ~= singleton (BinPkgName "creativeprompts-data")+          do T.utilsPackageNameBase ~= Just "creativeprompts-data"              newDebianization' level standards              T.changelog ~= (getL T.changelog old)              doWebsite (BinPkgName "creativeprompts-production") (theSite (BinPkgName "creativeprompts-production"))@@ -618,7 +618,7 @@     where       customize =           do newDebianization' (Just 7) (Just (StandardsVersion 3 9 3 Nothing))-             mapM_ (\ name -> T.installData +++= (BinPkgName "alex", singleton (name, name)))+             mapM_ (\ name -> T.installData (BinPkgName "alex") name name)                    [ "AlexTemplate"                    , "AlexTemplate-debug"                    , "AlexTemplate-ghc"@@ -662,9 +662,8 @@              T.maintainer ~= either (const Nothing) Just (parseMaintainer "David Fox <dsf@seereason.com>")              T.depends (BinPkgName "seereason-darcs-backups") %= (++ [[Rel (BinPkgName "anacron") Nothing Nothing]])              T.sourceSection ~= Just (MainSection "haskell")-             T.utilsPackageNames += utils-             T.installCabalExec +++= (utils, singleton ("seereason-darcs-backups", "/etc/cron.hourly"))-      utils = BinPkgName "seereason-darcs-backups"+             T.utilsPackageNameBase ~= Just "seereason-darcs-backups"+             T.installCabalExec (BinPkgName "seereason-darcs-backups") "seereason-darcs-backups" "/etc/cron.hourly"  copyChangelogDate :: Monad m => String -> DebT m () copyChangelogDate date =
cabal-debian.cabal view
@@ -1,11 +1,11 @@ Name:           cabal-debian-Version:        4.15.2+Version:        4.17.3 License:        BSD3 License-File:   debian/copyright Author:         David Fox <dsf@seereason.com> Category:       Debian, Distribution, System Maintainer:     David Fox <dsf@seereason.com>-Homepage:       http://src.seereason.com/cabal-debian+Homepage:       https://github.com/ddssff/cabal-debian Build-Type:     Simple Synopsis:       Create a debianization for a cabal package Cabal-Version: >= 1.8@@ -150,8 +150,8 @@ --   Manual: True  Source-Repository head-  type: darcs-  location: http://src.seereason.com/cabal-debian+  type: git+  location: https://github.com/ddssff/cabal-debian  Library  Hs-Source-Dirs: src@@ -216,7 +216,7 @@ --    Hs-Source-Dirs: ., ../../haskell-debian --    Build-Depends: regex-compat, bytestring, process-listlike, network, old-locale, time --  else- Build-depends: debian >= 3.81+ Build-depends: debian >= 3.83.2  Executable cabal-debian  Hs-Source-Dirs: .
changelog view
@@ -1,3 +1,58 @@+haskell-cabal-debian (4.17.3) unstable; urgency=low++  * Moved source repository to github.com.++ -- David Fox <dsf@seereason.com>  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 <dsf@seereason.com>  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 <dsf@seereason.com>  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 <dsf@seereason.com>  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 <dsf@seereason.com>  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 <dsf@seereason.com>  Tue, 12 Aug 2014 07:47:17 -0700++haskell-cabal-debian (4.15.1) unstable; urgency=low++  * Add Data and Typeable instances.++ -- David Fox <dsf@seereason.com>  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.
debian/Debianize.hs view
@@ -6,32 +6,31 @@ import Data.Text as Text (pack) import Debian.Changes (ChangeLog(ChangeLog)) import Debian.Debianize (inputChangeLog, inputDebianization)-import Debian.Debianize.Details (seereasonDefaultAtoms)+import Debian.Debianize.Details (debianDefaultAtoms) import Debian.Debianize.Finalize (debianization) import Debian.Debianize.Types as T     (changelog, compat, conflicts, control, depends, debianDescription, homepage,-     installCabalExec, sourceFormat, standardsVersion, utilsPackageNames, copyright)-import Debian.Debianize.Types.Atoms as T (Atoms, newAtoms)+     installCabalExec, sourceFormat, standardsVersion, utilsPackageNameBase, copyright)+import Debian.Debianize.Types.Atoms as T (Atoms, newAtoms, EnvSet(EnvSet)) import Debian.Debianize.Monad (Atoms, DebT, execDebT, evalDebT, execDebM) import Debian.Debianize.Output (compareDebianization) import Debian.Debianize.Prelude ((~=), (~?=), (%=), (+=), (++=), (+++=))-import Debian.Debianize.Types (Top(Top)) import Debian.Debianize.Types.SourceDebDescription (SourceDebDescription) import Debian.Policy (SourceFormat(Native3), StandardsVersion(StandardsVersion)) import Debian.Relation (BinPkgName(BinPkgName), Relation(Rel), VersionReq(SLT, GRE)) import Debian.Version (parseDebianVersion)+import Distribution.Compiler(CompilerFlavor(GHC)) import Prelude hiding (log) import System.Directory (copyFile)  main :: IO () main =-    do let top = Top "."-       -- Copy the changelog into the top directory so that hackage+    do -- Copy the changelog into the top directory so that hackage        -- will see it.        copyFile "debian/changelog" "changelog"-       log <- evalDebT (inputChangeLog top >> access changelog) newAtoms-       old <- execDebT (inputDebianization top) newAtoms-       new <- execDebT (debianization top seereasonDefaultAtoms (changelog ~?= log >> customize >> copyFirstLogEntry old)) newAtoms+       log <- newAtoms >>= evalDebT (inputChangeLog >> access changelog)+       old <- newAtoms >>= execDebT (inputDebianization (T.EnvSet "/" "/" "/"))+       new <- newAtoms >>= execDebT (debianization debianDefaultAtoms (changelog ~?= log >> customize >> copyFirstLogEntry old))        diff <- compareDebianization old new        case diff of          "" -> return ()@@ -44,7 +43,7 @@       customize =           do sourceFormat ~= Just Native3              standardsVersion ~= Just (StandardsVersion 3 9 3 Nothing)-             compat ~= Just 7+             compat ~= Just 9              copyright ~= Just (pack (unlines [ "This package is not part of the Debian GNU/Linux distribution."                                               , ""                                               , "Copyright: (c) 2010-2011, SeeReason Partners LLC"@@ -66,7 +65,7 @@              depends (BinPkgName "cabal-debian") %= (++ [[Rel (BinPkgName "haskell-devscripts") (Just (GRE (parseDebianVersion ("0.8.19" :: String)))) Nothing]])              installCabalExec +++= (BinPkgName "cabal-debian-tests", singleton ("cabal-debian-tests", "/usr/bin"))              installCabalExec +++= (BinPkgName "cabal-debian", singleton ("cabal-debian", "/usr/bin"))-             utilsPackageNames += BinPkgName "cabal-debian"+             utilsPackageNameBase ~= Just "cabal-debian"              -- extraDevDeps (BinPkgName "debian-policy")              homepage ~= Just (pack "http://src.seereason.com/cabal-debian") 
src/Debian/Debianize/BuildDependencies.hs view
@@ -1,10 +1,11 @@ -- | Compute the debianization of a cabal package.-{-# LANGUAGE CPP, OverloadedStrings, ScopedTypeVariables #-}+{-# LANGUAGE CPP, OverloadedStrings, ScopedTypeVariables, TupleSections #-} module Debian.Debianize.BuildDependencies     ( debianBuildDeps     , debianBuildDepsIndep     ) where +import Control.Applicative ((<$>)) import Control.Monad.State (MonadState(get)) import Control.Monad.Trans (MonadIO) import Data.Char (isSpace, toLower)@@ -13,24 +14,20 @@ import Data.List as List (filter, map, minimumBy, nub) import Data.Map as Map (lookup, Map) import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)-import qualified Data.Set as Set (member)+import Data.Set as Set (Set, member, toList, fromList, map, fold, union, empty) import Data.Version (showVersion, Version) import Debian.Debianize.Bundled (builtIn) import Debian.Debianize.DebianName (mkPkgName, mkPkgName') import Debian.Debianize.Monad as Monad (Atoms, DebT) import qualified Debian.Debianize.Types as T (buildDepends, buildDependsIndep, debianNameMap, epochMap, execMap, extraLibMap, missingDependencies, noDocumentationLibrary, noProfilingLibrary)-import Debian.Debianize.Types.Atoms (EnvSet(dependOS), compilerFlavor, buildEnv)+import Debian.Debianize.Types.Atoms (EnvSet(dependOS), buildEnv, compilerFlavors) import qualified Debian.Debianize.Types.BinaryDebDescription as B (PackageType(Development, Documentation, Profiling)) import Debian.Debianize.VersionSplits (packageRangesFromVersionSplits) import Debian.Orphans () import Debian.Relation (BinPkgName(..), Relation(..), Relations, checkVersionReq) import qualified Debian.Relation as D (BinPkgName(BinPkgName), Relation(..), Relations, VersionReq(EEQ, GRE, LTE, SGR, SLT)) import Debian.Version (DebianVersion, parseDebianVersion)-#if MIN_VERSION_Cabal(1,21,0)-import Distribution.Compiler (CompilerFlavor(GHC, GHCJS))-#else-import Distribution.Compiler (CompilerFlavor(GHC))-#endif+import Distribution.Compiler (CompilerFlavor(..)) import Distribution.Package (Dependency(..), PackageIdentifier(..), PackageName(PackageName)) import Distribution.PackageDescription (PackageDescription) import Distribution.PackageDescription as Cabal (allBuildInfo, BuildInfo(..), BuildInfo(buildTools, extraLibs, pkgconfigDepends), Executable(..))@@ -75,47 +72,59 @@     where       fixDeps :: Atoms -> [String] -> Relations       fixDeps atoms xs =-          concatMap (\ cab -> fromMaybe [[D.Rel (D.BinPkgName ("lib" ++ map toLower cab ++ "-dev")) Nothing Nothing]]+          concatMap (\ cab -> fromMaybe [[D.Rel (D.BinPkgName ("lib" ++ List.map toLower cab ++ "-dev")) Nothing Nothing]]                                         (Map.lookup cab (getL T.extraLibMap atoms))) xs  -- The haskell-cdbs package contains the hlibrary.mk file with -- the rules for building haskell packages.-debianBuildDeps :: MonadIO m => PackageDescription -> DebT m D.Relations+debianBuildDeps :: (MonadIO m, Functor m) => PackageDescription -> DebT m D.Relations debianBuildDeps pkgDesc =-    do deb <- get-       cDeps <- cabalDeps-       let bDeps = getL T.buildDepends deb-           prof = not $ getL T.noProfilingLibrary deb-       cfl <- access compilerFlavor+    do hcs <- access compilerFlavors+       let hcTypePairs =+               fold union empty $+                  Set.map (\ hc -> Set.map (hc,) $ hcPackageTypes hc) hcs+       cDeps <- cabalDeps hcTypePairs+       bDeps <- access T.buildDepends+       prof <- not <$> access T.noProfilingLibrary        let xs = nub $ [[D.Rel (D.BinPkgName "debhelper") (Just (D.GRE (parseDebianVersion ("7.0" :: String)))) Nothing],                        [D.Rel (D.BinPkgName "haskell-devscripts") (Just (D.GRE (parseDebianVersion ("0.8" :: String)))) Nothing],                        anyrel "cdbs"] ++-                      (case cfl of-                        GHC -> [anyrel "ghc"] ++ if prof then [anyrel "ghc-prof"] else []+                      (if member GHC hcs+                       then [anyrel "ghc"] ++ if prof+                                              then [anyrel "ghc-prof"]+                                              else []+                       else []) ++ #if MIN_VERSION_Cabal(1,21,0)-                        GHCJS -> [anyrel "ghcjs"]+                      (if member GHCJS hcs then [anyrel "ghcjs"] else []) ++ #endif-                        x -> error ("Unsupported compiler flavor: " ++ show x)) ++-                      bDeps ++-                      cDeps+                       bDeps +++                       cDeps        filterMissing xs     where-      cabalDeps =+      cabalDeps hcTypePairs =           do deps <- allBuildDepends                           (Cabal.buildDepends pkgDesc ++ concatMap (Cabal.targetBuildDepends . Cabal.buildInfo) (Cabal.executables pkgDesc))                           (concatMap buildTools . allBuildInfo $ pkgDesc)                           (concatMap pkgconfigDepends . allBuildInfo $ pkgDesc)                           (concatMap extraLibs . allBuildInfo $ pkgDesc)-             mapM buildDependencies (List.filter (not . selfDependency (Cabal.package pkgDesc)) deps) >>= return . concat+             mapM (buildDependencies hcTypePairs) (List.filter (not . selfDependency (Cabal.package pkgDesc)) deps) >>= return . concat+      hcPackageTypes :: CompilerFlavor -> Set B.PackageType+      hcPackageTypes GHC = fromList [B.Development, B.Profiling]+      hcPackageTypes GHCJS = fromList [B.Development]+      hcPackageTypes hc = error $ "Unsupported compiler flavor: " ++ show hc -debianBuildDepsIndep :: MonadIO m => PackageDescription -> DebT m D.Relations++debianBuildDepsIndep :: (MonadIO m, Functor m) => PackageDescription -> DebT m D.Relations debianBuildDepsIndep pkgDesc =-    do doc <- get >>= return . not . getL T.noDocumentationLibrary+    do hcs <- access compilerFlavors+       doc <- get >>= return . not . getL T.noDocumentationLibrary        bDeps <- get >>= return . getL T.buildDependsIndep        cDeps <- cabalDeps-       let xs = if doc-                then nub $ [anyrel "ghc-doc"] ++ bDeps ++ concat cDeps-                else []+       let xs = nub $ if doc+                      then (if member GHC hcs then [anyrel "ghc-doc"] else []) +++                           (if member GHCJS hcs then [anyrel "ghcjs"] else []) +++                           bDeps ++ concat cDeps+                      else []        filterMissing xs     where       cabalDeps =@@ -138,23 +147,22 @@ -- | The documentation dependencies for a package include the -- documentation package for any libraries which are build -- dependencies, so we have access to all the cross references.-docDependencies :: MonadIO m => Dependency_ -> DebT m D.Relations-docDependencies (BuildDepends (Dependency name ranges)) = dependencies B.Documentation name ranges+docDependencies :: (MonadIO m, Functor m) => Dependency_ -> DebT m D.Relations+docDependencies (BuildDepends (Dependency name ranges)) =+    do hcs <- access compilerFlavors+       concat <$> mapM (\ hc -> dependencies hc B.Documentation name ranges) (toList hcs) docDependencies _ = return []  -- | The Debian build dependencies for a package include the profiling -- libraries and the documentation packages, used for creating cross -- references.  Also the packages associated with extra libraries.-buildDependencies :: MonadIO m => Dependency_ -> DebT m D.Relations-buildDependencies (BuildDepends (Dependency name ranges)) =-    do hc <- access compilerFlavor-       dev <- dependencies B.Development name ranges-       prof <- if hc == GHC then dependencies B.Profiling name ranges else return []-       return $ dev ++ prof-buildDependencies dep@(ExtraLibs _) =-    do mp <- get >>= return . getL T.execMap+buildDependencies :: (MonadIO m, Functor m) => Set (CompilerFlavor, B.PackageType) -> Dependency_ -> DebT m D.Relations+buildDependencies hcTypePairs (BuildDepends (Dependency name ranges)) =+    concat <$> mapM (\ (hc, typ) -> dependencies hc typ name ranges) (toList hcTypePairs)+buildDependencies _ dep@(ExtraLibs _) =+    do mp <- access T.execMap        return $ concat $ adapt mp dep-buildDependencies dep =+buildDependencies _ dep =     case unboxDependency dep of       Just (Dependency _name _ranges) ->           do mp <- get >>= return . getL T.execMap@@ -199,10 +207,9 @@ -- | Turn a cabal dependency into debian dependencies.  The result -- needs to correspond to a single debian package to be installed, -- so we will return just an OrRelation.-dependencies :: MonadIO m => B.PackageType -> PackageName -> VersionRange -> DebT m Relations-dependencies typ name cabalRange =+dependencies :: MonadIO m => CompilerFlavor -> B.PackageType -> PackageName -> VersionRange -> DebT m Relations+dependencies hc typ name cabalRange =     do atoms <- get-       hc <- access compilerFlavor        -- 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@@ -213,8 +220,8 @@                     -- 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 n typ, r)) (packageRangesFromVersionSplits splits')-       mapM convert alts >>= mapM (doBundled typ name) . convert' . canonical . Or . catMaybes+                    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@@ -269,18 +276,18 @@ doBundled :: MonadIO m =>              B.PackageType           -> PackageName+          -> CompilerFlavor           -> [D.Relation]           -> DebT m [D.Relation]-doBundled typ name rels =+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 typ) Nothing Nothing+      comp = D.Rel (compilerPackageName hc typ) Nothing Nothing       doRel :: MonadIO m => D.Relation -> DebT m [D.Relation]       doRel rel@(D.Rel dname req _) = do         -- gver <- access ghcVersion-        hc <- access compilerFlavor         splits <- access T.debianNameMap         root <- access buildEnv >>= return . dependOS         -- Look at what version of the package is provided by the compiler.@@ -301,10 +308,15 @@                  -- compiler doesn't conflict with the package's                  -- debian name.                  (if isNothing pver || dname /= naiveDebianName || not (conflictsWithHC naiveDebianName) then [rel] else [])-      compilerPackageName B.Documentation = D.BinPkgName "ghc-doc"-      compilerPackageName B.Profiling = D.BinPkgName "ghc-prof"-      compilerPackageName B.Development = D.BinPkgName "ghc"-      compilerPackageName _ = D.BinPkgName "ghc" -- whatevs+      compilerPackageName GHC B.Documentation = D.BinPkgName "ghc-doc"+      compilerPackageName GHC B.Profiling = D.BinPkgName "ghc-prof"+      compilerPackageName GHC B.Development = D.BinPkgName "ghc"+      compilerPackageName GHC _ = D.BinPkgName "ghc" -- whatevs+      compilerPackageName GHCJS B.Documentation = D.BinPkgName "ghcjs"+      compilerPackageName GHCJS B.Profiling = error "Profiling not supported for GHCJS"+      compilerPackageName GHCJS B.Development = D.BinPkgName "ghcjs"+      compilerPackageName GHCJS _ = D.BinPkgName "ghcjs" -- whatevs+      compilerPackageName x _ = error $ "Unsupported compiler flavor: " ++ show x        -- FIXME: we are assuming here that ghc conflicts with all the       -- library packages it provides but it no longer conflicts with
src/Debian/Debianize/DebianName.hs view
@@ -1,22 +1,24 @@ {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeFamilies #-} {-# OPTIONS -Wall -Wwarn -fno-warn-name-shadowing -fno-warn-orphans #-} module Debian.Debianize.DebianName-    ( debianName             -- Used in Debian.Debianize.Files and+    ( debianName+    , debianNameBase     , mkPkgName     , mkPkgName'     , mapCabal     , splitCabal     ) where +import Control.Applicative ((<$>)) import Data.Char (toLower) import Data.Lens.Lazy (access) import Data.Map as Map (lookup, alter) import Data.Version (Version, showVersion) import Debian.Debianize.Types.BinaryDebDescription as Debian (PackageType(..))-import Debian.Debianize.Types.Atoms as T (debianNameMap, packageDescription, compilerFlavor)+import Debian.Debianize.Types.Atoms as T (debianNameMap, packageDescription, utilsPackageNameBase) import Debian.Debianize.Monad (DebT) import Debian.Debianize.Prelude ((%=))-import Debian.Debianize.VersionSplits (DebBase(DebBase), insertSplit, doSplits, VersionSplits, makePackage)+import Debian.Debianize.VersionSplits (DebBase(DebBase, unDebBase), insertSplit, doSplits, VersionSplits, makePackage) import Debian.Orphans () import Debian.Relation (PkgName(..), Relations) import qualified Debian.Relation as D (VersionReq(EEQ))@@ -34,45 +36,50 @@     deriving (Eq, Show)  -- | Build the Debian package name for a given package type.-debianName :: (Monad m, PkgName name) => PackageType -> DebT m name-debianName typ =-    do cfl <- access compilerFlavor-       Just pkgDesc <- access packageDescription-       let pkgId = Cabal.package pkgDesc-       nameMap <- access T.debianNameMap-       return $ debianName' cfl (Map.lookup (pkgName pkgId) nameMap) typ pkgId+debianName :: (Monad m, Functor m, PkgName name) => PackageType -> CompilerFlavor -> DebT m name+debianName typ cfl =+    do base <-+           case (typ, cfl) of+             (Utilities, GHC) -> access utilsPackageNameBase >>= maybe (((\ base -> "haskell-" ++ base ++ "-utils") . unDebBase) <$> debianNameBase) return+             (Utilities, _) -> access utilsPackageNameBase >>= maybe (((\ base -> base ++ "-utils") . unDebBase) <$> debianNameBase) return+             _ -> 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.-debianName' :: (PkgName name) => CompilerFlavor -> Maybe VersionSplits -> PackageType -> PackageIdentifier -> name-debianName' cfl msplits typ pkgId =-    case msplits of-      Nothing -> mkPkgName cfl pname typ-      Just splits -> (\ s -> mkPkgName' cfl s typ) $ doSplits splits version-    where-      -- def = mkPkgName cfl pname typ-      pname@(PackageName _) = pkgName pkgId-      version = (Just (D.EEQ (parseDebianVersion (showVersion (pkgVersion pkgId)))))+debianNameBase :: Monad m => DebT m DebBase+debianNameBase =+    do Just pkgDesc <- access packageDescription+       let pkgId = Cabal.package pkgDesc+       nameMap <- access T.debianNameMap+       let pname@(PackageName _) = pkgName pkgId+           version = (Just (D.EEQ (parseDebianVersion (showVersion (pkgVersion pkgId)))))+       case Map.lookup (pkgName pkgId) nameMap of+         Nothing -> return $ debianBaseName pname+         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 (debianBaseName pkg) typ+mkPkgName cfl pkg typ = mkPkgName' cfl typ (debianBaseName pkg) -mkPkgName' :: PkgName name => CompilerFlavor -> DebBase -> PackageType -> name-mkPkgName' cfl (DebBase base) typ =+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 -> "haskell-" ++ base ++ "-utils"+                Utilities -> base {- ++ case cfl of+                                          GHC -> ""+                                          _ -> "-" ++ map toLower (show cfl) -}                 Exec -> base-                Source' -> "haskell-" ++ base ++ ""+                Source -> base+                HaskellSource -> "haskell-" ++ base                 Cabal -> base     where prefix = "lib" ++ map toLower (show cfl) ++ "-" 
src/Debian/Debianize/Files.hs view
@@ -9,11 +9,11 @@ import Control.Monad.Trans (lift) import Control.Monad.Writer (WriterT, execWriterT, tell) import Data.Lens.Lazy (access, getL)-import Data.List as List (map, unlines)-import Data.Map as Map (Map, toList, fromListWithKey, mapKeys)+import Data.List as List (map)+import Data.Map as Map (Map, map, toList, fromListWithKey, mapKeys, insertWith) import Data.Maybe import Data.Monoid ((<>), mempty)-import Data.Set as Set (toList, member)+import Data.Set as Set (toList, member, fold) import Data.Text as Text (Text, pack, unpack, lines, unlines, strip, null) import Debian.Control (Control'(Control, unControl), Paragraph'(Paragraph), Field'(Field)) import Debian.Debianize.Goodies (makeRulesHead)@@ -72,14 +72,18 @@  installs :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] installs =-    (map (\ (path, pairs) -> (path, pack (List.unlines (map (\ (src, dst) -> src <> " " <> dst) (Set.toList pairs))))) . Map.toList . mapKeys pathf) <$> (lift $ access T.install)+    (Map.toList . Map.map unlines . Set.fold doAtom mempty) <$> (lift $ access T.atomSet)     where+      doAtom (T.Install b from dest) mp = Map.insertWith (++) (pathf b) [pack (from <> " " <> dest)] mp+      doAtom _ mp = mp       pathf name = "debian" </> show (pretty name) ++ ".install"  dirs :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] dirs =-    (map (\ (path, dirs') -> (path, pack (List.unlines (Set.toList dirs')))) . Map.toList . mapKeys pathf) <$> (lift $ access T.installDir)+    (Map.toList . Map.map unlines . Set.fold doAtom mempty) <$> (lift $ access T.atomSet)     where+      doAtom (T.InstallDir b dir) mp = Map.insertWith (++) (pathf b) [pack dir] mp+      doAtom _ mp = mp       pathf name = "debian" </> show (pretty name) ++ ".dirs"  init :: (Monad m, Functor m) => FilesT m [(FilePath, Text)]@@ -91,15 +95,17 @@ -- FIXME - use a map and insertWith, check for multiple entries logrotate :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] logrotate =-    (map (\ (path, stanzas) -> (path, Text.unlines (Set.toList stanzas))) . Map.toList . mapKeys pathf) <$> (lift $ access T.logrotateStanza)+    (Map.toList . Map.map (\ stanzas -> Text.unlines (Set.toList stanzas)) . mapKeys pathf) <$> (lift $ access T.logrotateStanza)     where       pathf name = "debian" </> show (pretty name) ++ ".logrotate"  -- | Assemble all the links by package and output one file each links :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] links =-    (map (\ (path, pairs) -> (path, pack (List.unlines (map (\ (loc, txt) -> loc ++ " " ++ txt) (Set.toList pairs))))) . Map.toList . mapKeys pathf) <$> (lift $ access T.link)+    (Map.toList . Map.map unlines . Set.fold doAtom mempty) <$> (lift $ access T.atomSet)     where+      doAtom (T.Link b loc text) mp = Map.insertWith (++) (pathf b) [pack loc <> " " <> pack text] mp+      doAtom _ mp = mp       pathf name = "debian" </> show (pretty name) ++ ".links"  postinstFiles :: (Monad m, Functor m) => FilesT m [(FilePath, Text)]
src/Debian/Debianize/Finalize.hs view
@@ -15,33 +15,34 @@ import Data.Digest.Pure.MD5 (md5) import Data.Lens.Lazy (access, getL) import Data.List as List (intercalate, map, nub, unlines)-import Data.Map as Map (delete, elems, lookup, map, Map, toList, unionsWith)+import Data.Map as Map (delete, elems, lookup, Map, toList, insertWith) import Data.Maybe (fromMaybe, isJust)-import Data.Monoid ((<>))-import Data.Set as Set (difference, filter, fromList, map, null, Set, singleton, toList, union, unions)+import Data.Monoid ((<>), mempty)+import Data.Set as Set (difference, filter, fromList, map, null, Set, singleton, toList, union, unions, fold) import Data.Set.Extra as Set (mapM_) import Data.Text as Text (pack, unlines, unpack) import Debian.Changes (ChangeLog(..), ChangeLogEntry(..)) import Debian.Debianize.BuildDependencies (debianBuildDeps, debianBuildDepsIndep) import Debian.Debianize.Changelog (dropFutureEntries)-import Debian.Debianize.DebianName (debianName)+import Debian.Debianize.DebianName (debianName, debianNameBase) import Debian.Debianize.Goodies (backupAtoms, describe, execAtoms, serverAtoms, siteAtoms, watchAtom) import Debian.Debianize.Input (dataDir, inputCabalization, inputChangeLog, inputMaintainer) import Debian.Debianize.Monad as Monad (DebT) import Debian.Debianize.Options (compileCommandlineArgs, compileEnvironmentArgs)-import Debian.Debianize.Prelude ((%=), (+++=), (+=), foldEmpty, fromEmpty, fromSingleton, (~=), (~?=))-import qualified Debian.Debianize.Types as T (apacheSite, backups, binaryArchitectures, binaryPackages, binarySection, breaks, buildDepends, buildDependsIndep, buildDir, builtUsing, changelog, comments, compat, conflicts, debianDescription, debVersion, depends, epochMap, executable, extraDevDeps, extraLibMap, file, install, installCabalExec, installCabalExecTo, installData, installDir, installTo, intermediateFiles, license, link, maintainer, noDocumentationLibrary, noProfilingLibrary, noHoogle, packageDescription, packageType, preDepends, provides, recommends, replaces, revision, rulesFragments, serverInfo, source, sourcePackageName, sourcePriority, sourceSection, suggests, utilsPackageNames, verbosity, watch, website)-import qualified Debian.Debianize.Types.Atoms as A (InstallFile(execName, sourceDir), showAtoms, compilerFlavor)-import qualified Debian.Debianize.Types.BinaryDebDescription as B (BinaryDebDescription, package, PackageType(Development, Documentation, Exec, Profiling, Source', Utilities))+import Debian.Debianize.Prelude ((%=), (+=), foldEmpty, fromEmpty, fromSingleton, (~=), (~?=))+import qualified Debian.Debianize.Types as T (apacheSite, backups, binaryArchitectures, binaryPackages, binarySection, breaks, buildDepends, buildDependsIndep, buildDir, builtUsing, changelog, comments, compat, conflicts, debianDescription, debVersion, depends, epochMap, executable, extraDevDeps, extraLibMap, file, install, installCabalExec, installData, installDir, installTo, intermediateFiles, license, link, maintainer, noDocumentationLibrary, noProfilingLibrary, noHoogle, packageDescription, packageType, preDepends, provides, recommends, replaces, revision, rulesFragments, serverInfo, source, sourcePackageName, sourcePriority, sourceSection, suggests, utilsPackageNameBase, verbosity, watch, website)+import qualified Debian.Debianize.Types.Atoms as A (InstallFile(execName, sourceDir), showAtoms, compilerFlavors, Atom(..), atomSet)+import qualified Debian.Debianize.Types.BinaryDebDescription as B (BinaryDebDescription, package, PackageType(Development, Documentation, Exec, Profiling, Source, HaskellSource, Utilities), PackageType)+import Debian.Debianize.VersionSplits (DebBase(DebBase)) import Debian.Orphans () import Debian.Policy (getDebhelperCompatLevel, haskellMaintainer, PackageArchitectures(Any, All), PackagePriority(Optional), Section(..)) import Debian.Pretty (pretty)-import Debian.Relation (BinPkgName, BinPkgName(BinPkgName), Relation(Rel), Relations)+import Debian.Relation (BinPkgName, BinPkgName(BinPkgName), SrcPkgName(SrcPkgName), Relation(Rel), Relations) import qualified Debian.Relation as D (BinPkgName(BinPkgName), Relation(..)) import Debian.Release (parseReleaseName) import Debian.Time (getCurrentLocalRFC822Time) import Debian.Version (buildDebianVersion, DebianVersion, parseDebianVersion)-import Distribution.Compiler (CompilerFlavor(GHC))+import Distribution.Compiler (CompilerFlavor(GHC, GHCJS)) import Distribution.Package (Dependency(..), PackageIdentifier(..), PackageName(PackageName)) import Distribution.PackageDescription (PackageDescription) import Distribution.PackageDescription as Cabal (allBuildInfo, BuildInfo(buildable, extraLibs), Executable(buildInfo, exeName))@@ -83,7 +84,8 @@ --        paramter type to Maybe PackageDescription and propagate down thru code finalizeDebianization  :: (MonadIO m, Functor m) => String -> Maybe Int -> DebT m () finalizeDebianization date debhelperCompat =-    do addExtraLibDependencies+    do hcs <- Set.toList <$> access A.compilerFlavors+       List.mapM_ addExtraLibDependencies hcs        Just pkgDesc <- access T.packageDescription        T.watch ~?= Just (watchAtom (pkgName $ Cabal.package $ pkgDesc))        T.sourceSection ~?= Just (MainSection "haskell")@@ -99,8 +101,8 @@        access T.serverInfo >>= List.mapM_ (cabalExecBinaryPackage . fst) . Map.toList        access T.website >>= List.mapM_ (cabalExecBinaryPackage . fst) . Map.toList        putBuildDeps pkgDesc-       librarySpecs pkgDesc-       makeUtilsPackages pkgDesc+       List.mapM_ (librarySpecs pkgDesc) hcs+       List.mapM_ (makeUtilsPackage pkgDesc) hcs        -- Sketchy - I think more things that need expanded could be generated by the code        -- executed since the last expandAtoms.  Anyway, should be idempotent.        expandAtoms@@ -152,18 +154,21 @@ -- | 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 => DebT m ()-finalizeSourceName =-    do debName <- debianName B.Source'-       T.sourcePackageName ~?= Just debName+finalizeSourceName :: (Monad m, Functor m) => B.PackageType -> DebT m ()+finalizeSourceName typ =+    do DebBase debName <- debianNameBase+       T.sourcePackageName ~?= Just (SrcPkgName (case typ of+                                                   B.HaskellSource -> "haskell-" ++ debName+                                                   B.Source -> debName+                                                   _ -> error $ "finalizeSourceName: " ++ show typ))  finalizeMaintainer :: Monad m => DebT m () finalizeMaintainer =     T.maintainer ~?= Just haskellMaintainer -finalizeControl :: Monad m => DebT m ()+finalizeControl :: (Monad m, Functor m) => DebT m () finalizeControl =-    do finalizeSourceName+    do finalizeSourceName B.HaskellSource        finalizeMaintainer        Just src <- access T.sourcePackageName        maint <- access T.maintainer >>= return . fromMaybe (error "No maintainer")@@ -175,9 +180,9 @@ -- 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 => String -> DebT m ()+finalizeChangelog :: (Monad m, Functor m) => String -> DebT m () finalizeChangelog date =-    do finalizeSourceName+    do finalizeSourceName B.HaskellSource        finalizeMaintainer        ver <- debianVersion        src <- access T.sourcePackageName@@ -206,10 +211,10 @@ -- | 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) => DebT m ()-addExtraLibDependencies =+addExtraLibDependencies :: (Monad m, Functor m) => CompilerFlavor -> DebT m ()+addExtraLibDependencies hc =     do pkgDesc <- access T.packageDescription >>= maybe (error "addExtraLibDependencies: no PackageDescription") return-       devName <- debianName B.Development+       devName <- debianName B.Development hc        libMap <- access T.extraLibMap        binNames <- List.map (getL B.package) <$> access T.binaryPackages        when (any (== devName) binNames) (T.depends devName %= \ deps -> deps ++ g pkgDesc libMap)@@ -219,7 +224,7 @@       devDep :: Map String Relations -> String -> Relations       devDep libMap cab = maybe [[Rel (BinPkgName ("lib" ++ cab ++ "-dev")) Nothing Nothing]] id (Map.lookup cab libMap) -putBuildDeps :: MonadIO m => PackageDescription -> DebT m ()+putBuildDeps :: (MonadIO m, Functor m) => PackageDescription -> DebT m () putBuildDeps pkgDesc =     do deps <- debianBuildDeps pkgDesc        depsIndep <- debianBuildDepsIndep pkgDesc@@ -250,26 +255,26 @@        T.replaces b %= \ rels -> [anyrel "${haskell:Replaces}"] ++ rels        T.builtUsing b ~= [] -librarySpecs :: Monad m => PackageDescription -> DebT m ()-librarySpecs pkgDesc =-    do debName <- debianName B.Documentation+-- | Add the library paragraphs for a particular compiler flavor.+librarySpecs :: (Monad m, Functor m) => PackageDescription -> CompilerFlavor -> DebT m ()+librarySpecs pkgDesc hc =+    do debName <- debianName B.Documentation hc        let dev = isJust (Cabal.library pkgDesc)        doc <- get >>= return . not . getL T.noDocumentationLibrary        prof <- get >>= return . not . getL T.noProfilingLibrary-       cfl <- access A.compilerFlavor        hoogle <- get >>= return . not . getL T.noHoogle-       when dev (librarySpec Any B.Development)-       when (dev && prof && cfl == GHC) (librarySpec Any B.Profiling)+       when dev (librarySpec Any B.Development hc)+       when (dev && prof && hc == GHC) (librarySpec Any B.Profiling hc)        when (dev && doc && hoogle)-            (do docSpecsParagraph-                T.link +++= (debName, singleton ("/usr/share/doc" </> show (pretty debName) </> "html" </> cabal <.> "txt",-                                                 "/usr/lib/ghc-doc/hoogle" </> List.map toLower cabal <.> "txt")))+            (do docSpecsParagraph hc+                T.link debName ("/usr/share/doc" </> show (pretty debName) </> "html" </> cabal <.> "txt")+                               ("/usr/lib/ghc-doc/hoogle" </> List.map toLower cabal <.> "txt"))     where       PackageName cabal = pkgName (Cabal.package pkgDesc) -docSpecsParagraph :: Monad m => DebT m ()-docSpecsParagraph =-    do b <- debianName B.Documentation+docSpecsParagraph :: (Monad m, Functor m) => CompilerFlavor -> DebT m ()+docSpecsParagraph hc =+    do b <- debianName B.Documentation hc        binaryPackageRelations b B.Development -- not sure why this isn't Documentation, but I think there's a "good" reason        T.packageType b ~?= Just B.Documentation        desc <- describe b@@ -278,9 +283,9 @@        T.binarySection b ~?= Just (MainSection "doc")        T.debianDescription b ~?= Just desc -librarySpec :: Monad m => PackageArchitectures -> B.PackageType -> DebT m ()-librarySpec arch typ =-    do b <- debianName typ+librarySpec :: (Monad m, Functor m) => PackageArchitectures -> B.PackageType -> CompilerFlavor -> DebT m ()+librarySpec arch typ hc =+    do b <- debianName typ hc        binaryPackageRelations b B.Development        T.packageType b ~?= Just typ        desc <- describe b@@ -294,17 +299,21 @@ -- files, assign them to the packages returned by the -- utilsPackageNames lens, and make sure those packages are in the -- source deb description.-makeUtilsPackages :: forall m. (Monad m, Functor m) => PackageDescription -> DebT m ()-makeUtilsPackages pkgDesc =+makeUtilsPackage :: forall m. (Monad m, Functor m) => PackageDescription -> CompilerFlavor -> DebT m ()+makeUtilsPackage pkgDesc hc =     do -- Files the cabal package expects to be installed        -- Files that are already assigned to any binary deb-       installedDataMap <- Map.unionsWith Set.union-                           <$> (sequence [(Map.map (Set.map fst) <$> access T.install),-                                          (Map.map (Set.map fst) <$> access T.installTo),-                                          (Map.map (Set.map fst) <$> access T.installData)]) :: DebT m (Map BinPkgName (Set FilePath))-       installedExecMap <- Map.unionsWith Set.union-                           <$> (sequence [(Map.map (Set.map fst) <$> access T.installCabalExec),-                                          (Map.map (Set.map fst) <$> access T.installCabalExecTo)]) :: DebT m (Map BinPkgName (Set String))+       installedDataMap <- Set.fold (\ x r ->+                                         case x of+                                           A.Install b from _ -> Map.insertWith Set.union b (singleton from) r+                                           A.InstallTo b from _ -> Map.insertWith Set.union b (singleton from) r+                                           A.InstallData b from _ -> Map.insertWith Set.union b (singleton from) r+                                           _ -> r) mempty <$> access A.atomSet :: DebT m (Map BinPkgName (Set FilePath))+       installedExecMap <- Set.fold (\ x r ->+                                         case x of+                                           A.InstallCabalExec b name _ -> Map.insertWith Set.union b (singleton name) r+                                           A.InstallCabalExecTo b name _ -> Map.insertWith Set.union b (singleton name) r+                                           _ -> r) mempty <$> access A.atomSet :: DebT m (Map BinPkgName (Set String))         -- The names of cabal executables that go into eponymous debs        insExecPkg <- access T.executable >>= return . Set.map ename . Set.fromList . elems@@ -318,44 +327,45 @@        let availableData = Set.union installedData dataFilePaths            availableExec = Set.union installedExec execFilePaths -       access T.utilsPackageNames >>= \ names ->-           when (Set.null names) (debianName B.Utilities >>= \ name -> T.utilsPackageNames ~= singleton name)-       utilsPackages <- access T.utilsPackageNames+       access T.utilsPackageNameBase >>= \ name ->+           case name of+             Nothing -> debianName B.Utilities hc >>= \ (BinPkgName name') -> T.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 $ foldr (Map.delete) installedDataMap (Set.toList utilsPackages)-           installedExecOther =-               Set.union (tr "insExecPkg: " insExecPkg) $-                                Set.unions $ Map.elems $ foldr (Map.delete) (tr "installedExec: " installedExecMap) (Set.toList utilsPackages)+       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 (tr "availableExec: " availableExec) (tr "installedExecOther: " installedExecOther)+           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))-            (Set.mapM_ (\ p -> do -- This is really for all binary debs except the libraries - I'm not sure why-                                  T.rulesFragments += (pack ("build" </> show (pretty p) ++ ":: build-$(HC)-stamp"))-                                  T.binaryArchitectures p ~?= Just (if Set.null utilsExec then All else Any)-                                  T.binarySection p ~?= Just (MainSection "misc")-                                  binaryPackageRelations p B.Utilities) utilsPackages)+       when (not (Set.null utilsData && Set.null utilsExec)) $ do+         -- This is really for all binary debs except the libraries - I'm not sure why+         T.rulesFragments += (pack ("build" </> show (pretty b) ++ ":: build-ghc-stamp"))+         T.binaryArchitectures b ~?= Just (if Set.null utilsExec then All else Any)+         T.binarySection b ~?= Just (MainSection "misc")+         binaryPackageRelations b B.Utilities        -- Add the unassigned files to the utils packages-       Set.mapM_ (\ p -> Set.mapM_ (\ pair -> T.installData +++= (p, singleton pair)) utilsDataMissing) utilsPackages-       Set.mapM_ (\ p -> Set.mapM_ (\ name -> T.installCabalExec +++= (p, singleton (name, "usr/bin"))) (tr "utilsExecMissing: " utilsExecMissing)) utilsPackages+       Set.mapM_ (uncurry (T.installData b)) utilsDataMissing+       Set.mapM_ (\ name -> T.installCabalExec b name "usr/bin") utilsExecMissing     where       ename i =           case A.sourceDir i of             (Nothing) -> A.execName i             (Just s) ->  s </> A.execName i -tr :: Show a => String -> a -> a-tr _label x = {- trace ("(trace " ++ _label ++ show x ++ ")") -} x- expandAtoms :: Monad m => DebT m () expandAtoms =-    do builddir <- get >>= return . fromEmpty (singleton "dist-ghc/build") . getL T.buildDir+    do hcs <- access A.compilerFlavors >>= return . Set.toList+       builddir <- access T.buildDir >>= return . fromEmpty (case hcs of+                                                               [GHC] -> singleton "dist-ghc/build"+                                                               [GHCJS] -> singleton "dist-ghcjs/build"+                                                               _ -> error $ "Unexpected compiler: " ++ show hcs)        dDir <- access T.packageDescription >>= maybe (error "expandAtoms") (return . dataDir)        expandApacheSites        expandInstallCabalExecs (fromSingleton (error "no builddir") (\ xs -> error $ "multiple builddirs:" ++ show xs) builddir)@@ -374,46 +384,74 @@              List.mapM_ expandApacheSite (Map.toList mp)           where             expandApacheSite (b, (dom, log, text)) =-                do T.link +++= (b, singleton ("/etc/apache2/sites-available/" ++ dom, "/etc/apache2/sites-enabled/" ++ dom))-                   T.installDir +++= (b, singleton log)-                   T.file +++= (b, singleton ("/etc/apache2/sites-available" </> dom, text))+                do T.link b ("/etc/apache2/sites-available/" ++ dom) ("/etc/apache2/sites-enabled/" ++ dom)+                   T.installDir b log+                   T.file b ("/etc/apache2/sites-available" </> dom) text +      -- Turn A.InstallCabalExec into A.Install       expandInstallCabalExecs :: Monad m => FilePath -> DebT m ()-      expandInstallCabalExecs builddir =-          do mp <- get >>= return . getL T.installCabalExec-             List.mapM_ (\ (b, pairs) -> Set.mapM_ (\ (name, dst) -> T.install +++= (b, singleton (builddir </> name </> name, dst))) pairs) (Map.toList mp)+      expandInstallCabalExecs builddir = do+        hcs <- access A.compilerFlavors >>= return . Set.toList+        access A.atomSet >>= List.mapM_ (doAtom hcs) . Set.toList+          where+            doAtom [GHC] (A.InstallCabalExec b name dest) = T.install b (builddir </> name </> name) dest+            -- A GHCJS executable is a directory with files, copy them+            -- all into place.+            doAtom [GHCJS] (A.InstallCabalExec b name dest) =+                T.rulesFragments +=+                     (Text.unlines+                        [ pack ("binary-fixup" </> show (pretty b)) <> "::"+                        , pack ("\t(cd " <> builddir </> name <> " && find " <> name <.> "jsexe" <> " -type f) |\\\n" <>+                                       "\t  while read i; do install -Dp " <> builddir </> name </> "$$i debian" </> show (pretty b) </> makeRelative "/" dest </> "$$i; done") ])+            doAtom _ _ = return () +      -- Turn A.InstallCabalExecTo into a make rule       expandInstallCabalExecTo :: Monad m => FilePath -> DebT m ()-      expandInstallCabalExecTo builddir =-          do mp <- get >>= return . getL T.installCabalExecTo-             List.mapM_ (\ (b, pairs) -> Set.mapM_ (\ (n, d) -> T.rulesFragments += (Text.unlines-                                                                                     [ pack ("binary-fixup" </> show (pretty b)) <> "::"-                                                                                     , "\tinstall -Dps " <> pack (builddir </> n </> n) <> " " <> pack ("debian" </> show (pretty b) </> makeRelative "/" d) ])) pairs) (Map.toList mp)+      expandInstallCabalExecTo builddir = do+        hcs <- access A.compilerFlavors >>= return . Set.toList+        access A.atomSet >>= List.mapM_ (doAtom hcs) . Set.toList+          where+            doAtom [GHC] (A.InstallCabalExecTo b name dest) =+                T.rulesFragments += (Text.unlines+                                       [ pack ("binary-fixup" </> show (pretty b)) <> "::"+                                       , "\tinstall -Dps " <> pack (builddir </> name </> name) <> " "+                                                           <> pack ("debian" </> show (pretty b) </> makeRelative "/" dest) ])+            doAtom hcs (A.InstallCabalExecTo b name dest) = error $ "expandInstallCabalExecTo " ++ show hcs ++ " " ++ show (A.InstallCabalExecTo b name dest)+            doAtom _ _ = return () +      -- Turn A.InstallData into either an Install or an InstallTo       expandInstallData :: Monad m => FilePath -> DebT m ()       expandInstallData dDir =-          do mp <- get >>= return . getL T.installData-             List.mapM_ (\ (b, pairs) -> Set.mapM_ (\ (s, d) ->-                                                        if takeFileName s == takeFileName d-                                                        then T.install +++= (b, singleton (s, (dDir </> makeRelative "/" (takeDirectory d))))-                                                        else T.installTo +++= (b, singleton (s, (dDir </> makeRelative "/" d)))) pairs) (Map.toList mp)+          access A.atomSet >>= List.mapM_ doAtom . Set.toList+          where+            doAtom (A.InstallData b from dest) =+                if takeFileName from == takeFileName dest+                then T.install b from (dDir </> makeRelative "/" (takeDirectory dest))+                else T.installTo b from (dDir </> makeRelative "/" dest)+            doAtom _ = return () +      -- Turn A.InstallTo into a make rule       expandInstallTo :: Monad m => DebT m ()       expandInstallTo =-          do mp <- get >>= return . getL T.installTo-             List.mapM_ (\ (p, pairs) -> Set.mapM_ (\ (s, d) -> T.rulesFragments += (Text.unlines-                                                                                     [ pack ("binary-fixup" </> show (pretty p)) <> "::"-                                                                                     , "\tinstall -Dp " <> pack s <> " " <> pack ("debian" </> show (pretty p) </> makeRelative "/" d) ])) pairs) (Map.toList mp)+          access A.atomSet >>= List.mapM_ doAtom . Set.toList+          where+            doAtom (A.InstallTo b from dest) =+                T.rulesFragments += (Text.unlines [ pack ("binary-fixup" </> show (pretty b)) <> "::"+                                                  , "\tinstall -Dp " <> pack from <> " " <> pack ("debian" </> show (pretty b) </> makeRelative "/" dest) ])+            doAtom _ = return () +      -- Turn A.File into an intermediateFile and an A.Install       expandFile :: Monad m => DebT m ()       expandFile =-          do mp <- get >>= return . getL T.file-             List.mapM_ (\ (p, pairs) -> Set.mapM_ (\ (path, s) ->-                                                        do let (destDir', destName') = splitFileName path-                                                               tmpDir = "debian/cabalInstall" </> show (md5 (fromString (unpack s)))-                                                               tmpPath = tmpDir </> destName'-                                                           T.intermediateFiles += (tmpPath, s)-                                                           T.install +++= (p, singleton (tmpPath, destDir'))) pairs) (Map.toList mp)+          access A.atomSet >>= List.mapM_ doAtom . Set.toList+          where+            doAtom (A.File b path text) =+                do let (destDir', destName') = splitFileName path+                       tmpDir = "debian/cabalInstall" </> show (md5 (fromString (unpack text)))+                       tmpPath = tmpDir </> destName'+                   T.intermediateFiles += (tmpPath, text)+                   T.install b tmpPath destDir'+            doAtom _ = return ()        expandWebsite :: Monad m => DebT m ()       expandWebsite =
src/Debian/Debianize/Goodies.hs view
@@ -1,6 +1,7 @@ -- | 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@@ -24,14 +25,15 @@ import Data.Map as Map (insertWith) import Data.Maybe (fromMaybe) import Data.Monoid ((<>))-import Data.Set as Set (insert, union, singleton)+import Data.Set as Set (insert, union, singleton, toList) import Data.Text as Text (Text, pack, unlines, intercalate)-import Debian.Debianize.DebianName (debianName)+import Debian.Debianize.DebianName (debianNameBase) import Debian.Debianize.Monad (Atoms, DebT, execDebM) import Debian.Debianize.Prelude (trim, (%=), (+=), (++=), (+++=)) import qualified Debian.Debianize.Types as T import qualified Debian.Debianize.Types.Atoms as T import qualified Debian.Debianize.Types.BinaryDebDescription as B+import Debian.Debianize.VersionSplits (DebBase(DebBase)) import Debian.Orphans () import Debian.Pretty (Pretty(pretty)) import Debian.Policy (apacheLogDirectory, apacheErrorLog, apacheAccessLog, databaseDirectory, serverAppLog, serverAccessLog)@@ -173,10 +175,10 @@ siteAtoms :: BinPkgName -> T.Site -> Atoms -> Atoms siteAtoms b site =     execDebM-      (do T.installDir +++= (b, singleton "/etc/apache2/sites-available")-          T.link +++= (b, singleton ("/etc/apache2/sites-available/" ++ T.domain site, "/etc/apache2/sites-enabled/" ++ T.domain site))-          T.file +++= (b, singleton ("/etc/apache2/sites-available" </> T.domain site, apacheConfig))-          T.installDir +++= (b, singleton (apacheLogDirectory b))+      (do T.installDir b "/etc/apache2/sites-available"+          T.link b ("/etc/apache2/sites-available/" ++ T.domain site) ("/etc/apache2/sites-enabled/" ++ T.domain site)+          T.file b ("/etc/apache2/sites-available" </> T.domain site) apacheConfig+          T.installDir b (apacheLogDirectory b)           T.logrotateStanza +++= (b, singleton                                    (Text.unlines $ [ pack (apacheAccessLog b) <> " {"                                                    , "  copytruncate" -- hslogger doesn't notice when the log is rotated, maybe this will help@@ -335,7 +337,7 @@ -- FIXME - use Atoms execAtoms :: BinPkgName -> T.InstallFile -> Atoms -> Atoms execAtoms b ifile r =-    modL T.rulesFragments (Set.insert (pack ("build" </> show (pretty b) ++ ":: build-$(HC)-stamp"))) .+    modL T.rulesFragments (Set.insert (pack ("build" </> show (pretty b) ++ ":: build-ghc-stamp"))) .     fileAtoms b ifile $     r @@ -348,21 +350,28 @@ fileAtoms' :: BinPkgName -> Maybe FilePath -> String -> Maybe FilePath -> String -> Atoms -> Atoms fileAtoms' b sourceDir' execName' destDir' destName' r =     case (sourceDir', execName' == destName') of-      (Nothing, True) -> modL T.installCabalExec (insertWith Set.union b (singleton (execName', d))) r-      (Just s, True) -> modL T.install (insertWith Set.union b (singleton (s </> execName', d))) r-      (Nothing, False) -> modL T.installCabalExecTo (insertWith Set.union b (singleton (execName', (d </> destName')))) r-      (Just s, False) -> modL T.installTo (insertWith Set.union b (singleton (s </> execName', d </> destName'))) r+      (Nothing, True) -> execDebM (T.installCabalExec b execName' d) r+      (Just s, True) -> execDebM (T.install b (s </> execName') d) r+      (Nothing, False) -> execDebM (T.installCabalExecTo b execName' (d </> destName')) r+      (Just s, False) -> execDebM (T.installTo b (s </> execName') (d </> destName')) r     where       d = fromMaybe "usr/bin" destDir'  -- | Build a suitable value for the head of the rules file.-makeRulesHead :: Monad m => DebT m Text+makeRulesHead :: (Monad m, Functor m) => DebT m Text makeRulesHead =-    do b <- debianName B.Cabal-       hc <- access T.compilerFlavor-       let ls = ["DEB_CABAL_PACKAGE = " <> pack (show (pretty (b :: BinPkgName))),-                 "HC = " <> pack (map toLower (show hc)),-                 ""]+    do DebBase b <- debianNameBase+       compilers <- access T.compilerFlavors+       let ls = ["DEB_CABAL_PACKAGE = " <> pack b] +++                -- If there is a single entry in the compiler list we+                -- can tell debian/rules what compiler to use,+                -- otherwise it has to figure this out from the+                -- package names in debian/control.  This is required+                -- to build a package without a library.+                (case toList compilers of+                   [x] -> ["DEB_DEFAULT_COMPILER = " <> pack (map toLower (show x))]+                   _ -> []) +++                [""]        return $           Text.unlines $             ["#!/usr/bin/make -f", ""] ++
src/Debian/Debianize/Input.hs view
@@ -30,7 +30,7 @@ import Debian.Changes (ChangeLog(..), ChangeLogEntry(logWho), parseChangeLog) import Debian.Control (Control'(unControl), Paragraph'(..), stripWS, parseControlFromFile, Field, Field'(..), ControlFunctions) import qualified Debian.Debianize.Types as T (maintainer)-import qualified Debian.Debianize.Types.Atoms as T (changelog, compilerFlavor, makeAtoms)+import qualified Debian.Debianize.Types.Atoms as T (changelog, makeAtoms, compilerFlavors) import Debian.Debianize.Types.BinaryDebDescription (BinaryDebDescription, newBinaryDebDescription) import qualified Debian.Debianize.Types.BinaryDebDescription as B import qualified Debian.Debianize.Types.SourceDebDescription as S@@ -75,8 +75,7 @@ inputDebianization :: MonadIO m => EnvSet -> DebT m () inputDebianization envset =     do -- Erase any the existing information-       hc <- access T.compilerFlavor-       let atoms = T.makeAtoms hc envset+       let atoms = T.makeAtoms envset        put atoms        (ctl, _) <- inputSourceDebDescription        inputAtomsFromDirectory@@ -257,7 +256,7 @@ readLink :: Monad m => BinPkgName -> Text -> DebT m () readLink p line =     case words line of-      [a, b] -> link +++= (p, singleton (unpack a, unpack b))+      [a, b] -> link p (unpack a) (unpack b)       [] -> return ()       _ -> trace ("Unexpected value passed to readLink: " ++ show line) (return ()) @@ -266,52 +265,52 @@ 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, singleton (unpack (strip a), unpack (strip b)))+      (a, b) -> install p (unpack (strip a)) (unpack (strip b))  -- | Read a line from a debian .dirs file readDir :: Monad m => BinPkgName -> Text -> DebT m ()-readDir p line = installDir +++= (p, singleton (unpack line))+readDir p line = installDir p (unpack line)  inputCabalization :: (MonadIO m, Functor m) => DebT m () inputCabalization =-    do hc <- access T.compilerFlavor-       vb <- access verbosity >>= return . intToVerbosity'+    do vb <- access verbosity >>= return . intToVerbosity'        flags <- access cabalFlagAssignments        root <- dependOS <$> access buildEnv-       let mcid = newestAvailableCompilerId hc root-       ePkgDesc <- liftIO $ inputCabalization' vb flags mcid-       either (\ deps -> liftIO getCurrentDirectory >>= \ here ->-                         error $ "Missing dependencies in cabal package at " ++ here ++ ": " ++ show deps)-              (\ pkgDesc -> do-                 packageDescription ~= Just pkgDesc-                 -- This will contain either the contents of the file given in-                 -- the license-file: field or the contents of the license:-                 -- field.-                 license ~?= (Just (Cabal.license pkgDesc))+       hcs <- access T.compilerFlavors+       let cids = map (newestAvailableCompilerId root) (toList hcs)+       ePkgDescs <- liftIO $ inputCabalization' vb flags cids+       mapM_ (either (\ deps -> liftIO getCurrentDirectory >>= \ here ->+                                error $ "Missing dependencies in cabal package at " ++ here ++ ": " ++ show deps)+                     (\ pkgDesc -> do+                        packageDescription ~= Just pkgDesc+                        -- This will contain either the contents of the file given in+                        -- the license-file: field or the contents of the license:+                        -- field.+                        license ~?= (Just (Cabal.license pkgDesc)) #if MIN_VERSION_Cabal(1,19,0)-                 licenseFileText <- liftIO $ case Cabal.licenseFiles pkgDesc of-                                               [] -> return Nothing-                                               (path : _) -> readFileMaybe path -- better than nothing+                        licenseFileText <- liftIO $ case Cabal.licenseFiles pkgDesc of+                                                      [] -> return Nothing+                                                      (path : _) -> readFileMaybe path -- better than nothing #else-                 licenseFileText <- liftIO $ case Cabal.licenseFile pkgDesc of-                                               "" -> return Nothing-                                               path -> readFileMaybe path+                        licenseFileText <- liftIO $ case Cabal.licenseFile pkgDesc of+                                                      "" -> return Nothing+                                                      path -> readFileMaybe path #endif-                 licenseFile ~?= licenseFileText-                 copyright ~?= (case Cabal.copyright pkgDesc of-                                  "" -> Nothing-                                  s -> Just (pack s)))-              ePkgDesc+                        licenseFile ~?= licenseFileText+                        copyright ~?= (case Cabal.copyright pkgDesc of+                                         "" -> Nothing+                                         s -> Just (pack s))))+             ePkgDescs -inputCabalization' :: Verbosity -> Set (FlagName, Bool) -> CompilerId -> IO (Either [Dependency] PackageDescription)-inputCabalization' vb flags cid = do+inputCabalization' :: Verbosity -> Set (FlagName, Bool) -> [CompilerId] -> IO [Either [Dependency] PackageDescription]+inputCabalization' vb flags cids = do          descPath <- defaultPackageDesc vb          genPkgDesc <- readPackageDescription vb descPath-         case finalizePackageDescription (toList flags) (const True) (Platform buildArch buildOS) cid [] genPkgDesc of-           Left deps -> return (Left deps)-           Right (pkgDesc, _) ->-               do bracket (setFileCreationMask 0o022) setFileCreationMask $ \ _ -> autoreconf vb pkgDesc-                  return (Right pkgDesc)+         let finalized = map (\ cid -> finalizePackageDescription (toList flags) (const True) (Platform buildArch buildOS) cid [] genPkgDesc) cids+         mapM (either (return . Left)+                      (\ (pkgDesc, _) -> do bracket (setFileCreationMask 0o022) setFileCreationMask $ \ _ -> autoreconf vb pkgDesc+                                            return (Right pkgDesc)))+              finalized  -- | Run the package's configuration script. autoreconf :: Verbosity -> Cabal.PackageDescription -> IO ()
src/Debian/Debianize/Options.hs view
@@ -11,7 +11,7 @@ import Control.Monad.Trans (MonadIO, liftIO) import Data.Char (toLower, toUpper, isDigit, ord) import Data.Lens.Lazy (Lens)-import Data.Set (singleton)+import Data.Set (singleton, insert, delete) import Debian.Debianize.Goodies (doExecutable) import Debian.Debianize.Monad (DebT) import Debian.Debianize.Prelude (read', maybeRead, (+=), (~=), (%=), (++=), (+++=))@@ -19,14 +19,14 @@     (verbosity, dryRun, debAction, noDocumentationLibrary, noProfilingLibrary, noHoogle,      missingDependencies, sourcePackageName, cabalFlagAssignments, maintainer, buildDir, omitLTDeps,      sourceFormat, buildDepends, buildDependsIndep, extraDevDeps, depends, conflicts, replaces, provides,-     recommends, suggests, extraLibMap, debVersion, revision, epochMap, execMap, utilsPackageNames)-import Debian.Debianize.Types.Atoms (Atoms, EnvSet(..), InstallFile(..), DebAction(..), setBuildEnv, compilerFlavor)+     recommends, suggests, extraLibMap, debVersion, revision, epochMap, execMap, utilsPackageNameBase)+import Debian.Debianize.Types.Atoms (Atoms, EnvSet(..), InstallFile(..), DebAction(..), setBuildEnv, compilerFlavors) import Debian.Orphans () import Debian.Policy (SourceFormat(Quilt3), parseMaintainer) import Debian.Relation (BinPkgName(..), SrcPkgName(..), Relations, Relation(..)) import Debian.Relation.String (parseRelations) import Debian.Version (parseDebianVersion)-import Distribution.Compiler (CompilerFlavor)+import Distribution.Compiler (CompilerFlavor(..)) import Distribution.PackageDescription (FlagName(..)) import Distribution.Package (PackageName(..)) import Prelude hiding (readFile, lines, null, log, sum)@@ -76,7 +76,7 @@       Option "" ["executable"] (ReqArg (\ path -> executableOption path (\ bin e -> doExecutable bin e)) "SOURCEPATH or SOURCEPATH:DESTDIR")              (unlines [ "Create an individual binary package to hold this executable.  Other executables "                       , " and data files are gathered into a single utils package named 'haskell-packagename-utils'."]),-      Option "" ["default-package"] (ReqArg (\ name -> utilsPackageNames ~= singleton (BinPkgName name)) "DEB")+      Option "" ["default-package"] (ReqArg (\ name -> utilsPackageNameBase ~= Just name) "NAME")              (unlines [ "Set the name of the catch-all package that receives all the files not included in a library package or "                       , " some other executable package.  By default this is 'haskell-packagename-utils'."]),       Option "" ["disable-haddock"] (NoArg (noDocumentationLibrary ~= True))@@ -181,10 +181,20 @@                       , "be generated.  This determines which compiler will be available, which in turn"                       , "determines which basic libraries can be provided by the compiler.  This can be"                       , "set to /, but it must be set."]),-      Option "" ["hc", "compiler-flavor"] (ReqArg (\ s -> maybe (error $ "Invalid compiler id: " ++ show s)-                                                                (\ hc -> compilerFlavor ~= hc)-                                                                (readMaybe (map toUpper s) :: Maybe CompilerFlavor)) "COMPILER")-             (unlines [ "Specify which Haskell compiler: ghc, ghcjs, hugs, etc." ]),+      Option "" ["ghc"] (NoArg (compilerFlavors %= (insert GHC))) "Generate packages for GHC - same as --with-compiler GHC",+      Option "" ["no-ghc"] (NoArg (compilerFlavors %= (delete GHC))) "Do not generate packages for GHC - same as --without-compiler GHC",+      Option "" ["ghcjs"] (NoArg (compilerFlavors %= (insert GHCJS))) "Generate packages for GHCJS - same as --with-compiler GHCJS",+      Option "" ["no-ghcjs"] (NoArg (compilerFlavors %= (delete GHCJS))) "Do not generate packages for GHCJS - same as --without-compiler GHCJS",+      Option "" ["hugs"] (NoArg (compilerFlavors %= (insert Hugs))) "Generate packages for Hugs - same as --with-compiler GHC",+      Option "" ["no-hugs"] (NoArg (compilerFlavors %= (delete Hugs))) "Do not generate packages for Hugs - same as --without-compiler Hugs",+      Option "" ["with-compiler"] (ReqArg (\ s -> maybe (error $ "Invalid compiler id: " ++ show s)+                                                        (\ hc -> compilerFlavors %= insert hc)+                                                        (readMaybe (map toUpper s) :: Maybe CompilerFlavor)) "COMPILER")+             (unlines [ "Generate packages for this CompilerFlavor" ]),+      Option "" ["without-compiler"] (ReqArg (\ s -> maybe (error $ "Invalid compiler id: " ++ show s)+                                                           (\ hc -> compilerFlavors %= delete hc)+                                                           (readMaybe (map toUpper s) :: Maybe CompilerFlavor)) "COMPILER")+             (unlines [ "Do not generate packages for this CompilerFlavors, e.g. GHC" ]),       Option "f" ["flags"] (ReqArg (\ fs -> mapM_ (cabalFlagAssignments +=) (flagList fs)) "FLAGS")              (unlines [ "Flags to pass to the finalizePackageDescription function in"                       , "Distribution.PackageDescription.Configuration when loading the cabal file."]),
src/Debian/Debianize/Types.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE CPP, DeriveDataTypeable #-} module Debian.Debianize.Types     (     -- * Modes of operation@@ -38,7 +38,7 @@     , noProfilingLibrary     , noHoogle     , noDocumentationLibrary-    , utilsPackageNames+    , utilsPackageNameBase     , buildDir     , watch @@ -89,10 +89,10 @@     , installTo     , installData     , file-    , installDir-    , logrotateStanza     , installCabalExec     , installCabalExecTo+    , installDir+    , logrotateStanza      -- * Unknown, obsolete, internal     , flags
src/Debian/Debianize/Types/Atoms.hs view
@@ -2,6 +2,7 @@ -- record, the record that holds the input data from which the -- debianization is to be constructed. {-# LANGUAGE CPP, DeriveDataTypeable #-}+{-# OPTIONS_GHC -Wall #-} module Debian.Debianize.Types.Atoms {-    ( Atoms     , showAtoms@@ -16,12 +17,13 @@  import Control.Applicative ((<$>)) import Control.Category ((.))+import Control.Monad.State (StateT) import Control.Monad.Trans (MonadIO, liftIO) import Data.Generics (Data, Typeable)-import Data.Lens.Lazy (Lens, lens)+import Data.Lens.Lazy (Lens, lens, (%=)) import Data.Map as Map (Map) import Data.Monoid (Monoid(..))-import Data.Set as Set (Set)+import Data.Set as Set (Set, singleton, insert) import Data.Text (Text) import Debian.Changes (ChangeLog) import qualified Debian.Debianize.Types.SourceDebDescription as S@@ -30,7 +32,7 @@ import Debian.Policy (PackageArchitectures, PackagePriority, Section, SourceFormat) import Debian.Relation (BinPkgName, Relations, SrcPkgName) import Debian.Version (DebianVersion)-import Distribution.Compiler (CompilerFlavor)+import Distribution.Compiler (CompilerFlavor(GHC)) import Distribution.License (License) import Distribution.Package (PackageName) import Distribution.PackageDescription as Cabal (FlagName, PackageDescription)@@ -40,6 +42,14 @@ import System.FilePath ((</>)) import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr) +-- This enormous record is a mistake - instead it should be an Atom+-- type with lots of constructors, and the Atoms type is a set of+-- these.  Then we can cruise through the atom set converting the+-- elements into other simpler elements until they elements are all+-- simple enough to convert directly into a debianization.  At the+-- moment I really need this for the Install atoms, so I will try to+-- convert just that portion of the type to this new scheme.+ -- | Bits and pieces of information about the mapping from cabal package -- names and versions to debian package names and versions.  In essence, -- an 'Atoms' value represents a package's debianization.  The lenses in@@ -120,7 +130,7 @@       -- ^ A Fragment of debian/rules       , warning_ :: Set Text       -- ^ A warning to be reported later-      , utilsPackageNames_ :: Set BinPkgName+      , 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.       , changelog_ :: Maybe ChangeLog@@ -158,8 +168,6 @@       -- ^ Have Apache configure a site using PACKAGE, DOMAIN, LOGDIR, and APACHECONFIGFILE       , logrotateStanza_ :: Map BinPkgName (Set Text)       -- ^ Add a stanza of a logrotate file to the binary package-      , link_ :: Map BinPkgName (Set (FilePath, FilePath))-      -- ^ Create a symbolic link in the binary package       , postInst_ :: Map BinPkgName Text       -- ^ Script to run after install, should contain #DEBHELPER# line before exit 0       , postRm_ :: Map BinPkgName Text@@ -180,6 +188,9 @@       -- ^ Set the Section field of the source package       , binarySections_ :: Map BinPkgName Section       -- ^ Set the Section field of a binary package+#if 0+      , link_ :: Map BinPkgName (Set (FilePath, FilePath))+      -- ^ Create a symbolic link in the binary package       , install_ :: Map BinPkgName (Set (FilePath, FilePath))       -- ^ Install a build file into the binary package       , installTo_ :: Map BinPkgName (Set (FilePath, FilePath))@@ -194,6 +205,9 @@       -- ^ Install a cabal executable into the binary package at an exact location       , installDir_ :: Map BinPkgName (Set FilePath)       -- ^ Create a directory in the binary package+#else+      , atomSet_ :: Set Atom+#endif       , installInit_ :: Map BinPkgName Text       -- ^ Add an init.d file to the binary package       , executable_ :: Map BinPkgName InstallFile@@ -209,12 +223,31 @@       -- reason to use this is because we don't yet know the name of the dev library package.       , packageDescription_ :: Maybe PackageDescription       -- ^ The result of reading a cabal configuration file.-      , compilerFlavor_ :: CompilerFlavor-      -- ^ The newest available version of GHC in the build repository.  We don't support-      -- base repositories with no version of GHC, it has been standard in Debian and-      -- Ubuntu for quite some time.+      , compilerFlavors_ :: Set CompilerFlavor+      -- ^ Which compilers should we generate library packages for?       } deriving (Eq, 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)++type Atoms' = Set Atom+ data EnvSet = EnvSet     { cleanOS :: FilePath  -- ^ The output of the debootstrap command     , dependOS :: FilePath -- ^ An environment with build dependencies installed@@ -223,17 +256,17 @@  -- | Look for --buildenvdir in the command line arguments to get the -- changeroot path, use "/" if not present.-newAtoms :: MonadIO m => CompilerFlavor -> m Atoms-newAtoms hc = liftIO $ do+newAtoms :: MonadIO m => m Atoms+newAtoms = liftIO $ do   (roots, _, _) <- getOpt Permute [Option "buildenvdir" [] (ReqArg id "PATH")                                           "Directory containing the build environment"] <$> getArgs   let envset = case roots of                  (x : _) -> EnvSet {cleanOS = x </> "clean", dependOS = x </> "depend", buildOS = x </> "build"}                  _ -> EnvSet {cleanOS = "/", dependOS = "/", buildOS = "/"}-  return $ makeAtoms hc envset+  return $ makeAtoms envset -makeAtoms :: CompilerFlavor -> EnvSet -> Atoms-makeAtoms hc envset =+makeAtoms :: EnvSet -> Atoms+makeAtoms envset =     Atoms       { noDocumentationLibrary_ = False       , noProfilingLibrary_ = False@@ -255,7 +288,7 @@       , rulesHead_ = Nothing       , rulesFragments_ = mempty       , warning_ = mempty-      , utilsPackageNames_ = mempty+      , utilsPackageNameBase_ = Nothing       , changelog_ = Nothing       , comments_ = Nothing       , missingDependencies_ = mempty@@ -269,7 +302,6 @@       , licenseFile_ = mempty       , apacheSite_ = mempty       , logrotateStanza_ = mempty-      , link_ = mempty       , postInst_ = mempty       , postRm_ = mempty       , preInst_ = mempty@@ -280,6 +312,8 @@       , binaryPriorities_ = mempty       , sourceSection_ = Nothing       , binarySections_ = mempty+#if 0+      , link_ = mempty       , install_ = mempty       , installTo_ = mempty       , installData_ = mempty@@ -287,6 +321,9 @@       , installCabalExec_ = mempty       , installCabalExecTo_ = mempty       , installDir_ = mempty+#else+      , atomSet_ = mempty+#endif       , installInit_ = mempty       , executable_ = mempty       , serverInfo_ = mempty@@ -294,7 +331,7 @@       , backups_ = mempty       , extraDevDeps_ = mempty       , packageDescription_ = Nothing-      , compilerFlavor_ = hc+      , compilerFlavors_ = singleton GHC       }  -- | This record supplies information about the task we want done -@@ -477,10 +514,8 @@ missingDependencies = lens missingDependencies_ (\ a b -> b {missingDependencies_ = a})  -- | Override the package name used to hold left over data files and executables.--- Usually only one package is specified, but if more then one are they will each--- receive the same list of files.-utilsPackageNames :: Lens Atoms (Set BinPkgName)-utilsPackageNames = lens utilsPackageNames_ (\ a b -> b {utilsPackageNames_ = a})+utilsPackageNameBase :: Lens Atoms (Maybe String)+utilsPackageNameBase = lens utilsPackageNameBase_ (\ a b -> b {utilsPackageNameBase_ = a})  -- | Override the debian source package name constructed from the cabal name sourcePackageName :: Lens Atoms (Maybe SrcPkgName)@@ -593,6 +628,7 @@ logrotateStanza :: Lens Atoms (Map BinPkgName (Set Text)) logrotateStanza = lens logrotateStanza_ (\ a b -> b {logrotateStanza_ = a}) +#if 0 -- | Add entries to a binary deb's debian/foo.links file. link :: Lens Atoms (Map BinPkgName (Set (FilePath, FilePath))) link = lens link_ (\ a b -> b {link_ = a})@@ -632,7 +668,30 @@ -- FIXME: change signature to BinPkgName -> Lens Atoms (Set FilePath) installDir :: Lens Atoms (Map BinPkgName (Set FilePath)) installDir = lens installDir_ (\ a b -> b {installDir_ = a})+#else+-- | Access the set of new style atoms.+atomSet :: Lens Atoms (Set Atom)+atomSet = lens atomSet_ (\ a b -> b {atomSet_ = a}) +-- We need (%=_)+link :: Monad m => BinPkgName -> FilePath -> FilePath -> StateT Atoms m ()+link b from dest = atomSet %= (Set.insert $ Link b from dest) >> return ()+install :: Monad m => BinPkgName -> FilePath -> FilePath -> StateT Atoms m ()+install b from dest = atomSet %= (Set.insert $ Install b from dest) >> return ()+installTo :: Monad m => BinPkgName -> FilePath -> FilePath -> StateT Atoms m ()+installTo b from dest = atomSet %= (Set.insert $ InstallTo b from dest) >> return ()+installData :: Monad m => BinPkgName -> FilePath -> FilePath -> StateT Atoms m ()+installData b from dest = atomSet %= (Set.insert $ InstallData b from dest) >> return ()+file :: Monad m => BinPkgName -> FilePath -> Text -> StateT Atoms m ()+file b dest content = atomSet %= (Set.insert $ File b dest content) >> return ()+installCabalExec :: Monad m => BinPkgName -> String -> FilePath -> StateT Atoms m ()+installCabalExec b name dest = atomSet %= (Set.insert $ InstallCabalExec b name dest) >> return ()+installCabalExecTo :: Monad m => BinPkgName -> String -> FilePath -> StateT Atoms m ()+installCabalExecTo b name dest = atomSet %= (Set.insert $ InstallCabalExecTo b name dest) >> return ()+installDir :: Monad m => BinPkgName -> FilePath -> StateT Atoms m ()+installDir b dir = atomSet %= (Set.insert $ InstallDir b dir) >> return ()+#endif+ -- | Create an /etc/init.d file in the package -- FIXME: change signature to BinPkgName -> Lens Atoms Text installInit :: Lens Atoms (Map BinPkgName Text)@@ -643,8 +702,8 @@ intermediateFiles :: Lens Atoms (Set (FilePath, Text)) intermediateFiles = lens intermediateFiles_ (\ a b -> b {intermediateFiles_ = a}) -compilerFlavor :: Lens Atoms CompilerFlavor-compilerFlavor = lens compilerFlavor_ (\ a b -> b {compilerFlavor_ = a})+compilerFlavors :: Lens Atoms (Set CompilerFlavor)+compilerFlavors = lens compilerFlavors_ (\ a b -> b {compilerFlavors_ = a})  {- compilerFlavor :: Monad m => StateT Atoms m CompilerFlavor
src/Debian/Debianize/Types/BinaryDebDescription.hs view
@@ -65,7 +65,9 @@     | 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.)+    | 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)
src/Debian/Debianize/VersionSplits.hs view
@@ -2,7 +2,7 @@ -- number ranges. {-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} module Debian.Debianize.VersionSplits-    ( DebBase(DebBase)+    ( DebBase(DebBase, unDebBase)     -- * Combinators for VersionSplits     , VersionSplits     , makePackage@@ -29,7 +29,7 @@  -- | The base of a debian binary package name, the string that appears -- between "libghc-" and "-dev".-newtype DebBase = DebBase String deriving (Eq, Ord, Read, Show, Data, Typeable)+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
src/Debian/GHC.hs view
@@ -31,20 +31,20 @@ $(deriveMemoizable ''CompilerFlavor) $(deriveMemoizable ''BinPkgName) -withCompilerVersion :: CompilerFlavor -> FilePath -> (DebianVersion -> a) -> a-withCompilerVersion hc root f = f (newestAvailableCompiler hc root)+withCompilerVersion :: FilePath -> CompilerFlavor -> (DebianVersion -> a) -> a+withCompilerVersion root hc f = f (newestAvailableCompiler root hc)  -- | Memoized version of newestAvailable'-newestAvailable :: BinPkgName -> FilePath -> Maybe DebianVersion-newestAvailable pkg root =+newestAvailable :: FilePath -> BinPkgName -> Maybe DebianVersion+newestAvailable root pkg =     memoize2 f pkg root     where       f :: BinPkgName -> FilePath -> Maybe DebianVersion-      f pkg' root' = unsafePerformIO (newestAvailable' pkg' root')+      f pkg' root' = unsafePerformIO (newestAvailable' root' pkg')  -- | Look up the newest version of a deb available in the given changeroot.-newestAvailable' :: BinPkgName -> FilePath -> IO (Maybe DebianVersion)-newestAvailable' (BinPkgName name) root = do+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 $@@ -58,14 +58,14 @@       chroot "/" = id       chroot _ = useEnv root (return . force) -newestAvailableCompiler :: CompilerFlavor -> FilePath -> DebianVersion-newestAvailableCompiler hc root =+newestAvailableCompiler :: FilePath -> CompilerFlavor -> DebianVersion+newestAvailableCompiler root hc =     case debName hc of       Nothing -> error $ "newestAvailableCompiler - Unsupported CompilerFlavor: " ++ show hc-      Just pkg -> fromMaybe (error $ "newestAvailableCompiler - No versions of " ++ show hc ++ " available in " ++ show root) (newestAvailable pkg root)+      Just pkg -> fromMaybe (error $ "newestAvailableCompiler - No versions of " ++ show hc ++ " available in " ++ show root) (newestAvailable root pkg) -newestAvailableCompilerId :: CompilerFlavor -> FilePath -> CompilerId-newestAvailableCompilerId hc root = compilerIdFromDebianVersion hc (newestAvailableCompiler hc root)+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
src/Debian/Orphans.hs view
@@ -9,10 +9,9 @@ import Data.Monoid ((<>)) import Data.Version (Version(..), showVersion) import Debian.Changes (ChangeLog(..), ChangeLogEntry(..))-import Debian.Control (Field'(..)) import Debian.Pretty (Pretty(pretty), text, cat, empty) import Debian.Relation (Relation(..), VersionReq(..), ArchitectureReq(..),-                        BinPkgName(..), SrcPkgName(..))+                        SrcPkgName(..)) import Debian.Version (DebianVersion) import Distribution.Compiler (CompilerId(..)) #if !MIN_VERSION_Cabal(1,18,0)@@ -59,57 +58,24 @@ instance Ord PackageDescription where     compare = compare `on` package -{--instance Show (Control' String) where-    show _ = "<control file>"--instance Show ChangeLog where-    show _ = "<log entry>"--}--deriving instance Read ArchitectureReq-deriving instance Read BinPkgName-deriving instance Read ChangeLog-deriving instance Read ChangeLogEntry-deriving instance Read Relation-deriving instance Read SrcPkgName-deriving instance Read VersionReq--deriving instance Show ChangeLog-deriving instance Show ChangeLogEntry- 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 BinPkgName deriving instance Data ChangeLog deriving instance Data ChangeLogEntry--- deriving instance Data NameAddr deriving instance Data Relation-deriving instance Data SrcPkgName deriving instance Data VersionReq  deriving instance Typeable ArchitectureReq-deriving instance Typeable BinPkgName deriving instance Typeable ChangeLog deriving instance Typeable ChangeLogEntry--- deriving instance Typeable NameAddr deriving instance Typeable Relation-deriving instance Typeable SrcPkgName deriving instance Typeable VersionReq  deriving instance Ord ChangeLog deriving instance Ord ChangeLogEntry -{--instance Pretty SrcPkgName where-    pretty (SrcPkgName x) = pretty x--instance Pretty BinPkgName where-    pretty (BinPkgName x) = pretty x--}- #if !MIN_VERSION_Cabal(1,18,0) deriving instance Typeable License deriving instance Data Version@@ -147,8 +113,6 @@ instance Pretty (Maybe NameAddr) where     pretty Nothing = empty     pretty (Just x) = pretty x--deriving instance Show (Field' String)  instance Pretty VersionRange where     pretty range =
test-data/alex/output/debian/control view
@@ -6,8 +6,8 @@                , haskell-devscripts (>= 0.8)                , cdbs                , ghc-               , alex                , ghc-prof+               , alex                , libghc-quickcheck2-dev (>= 2)                , libghc-quickcheck2-prof (>= 2) Build-Depends-Indep: ghc-doc
test-data/alex/output/debian/rules view
@@ -1,7 +1,7 @@ #!/usr/bin/make -f  DEB_CABAL_PACKAGE = alex-HC = ghc+DEB_DEFAULT_COMPILER = ghc  include /usr/share/cdbs/1/rules/debhelper.mk include /usr/share/cdbs/1/class/hlibrary.mk
test-data/archive/output/debian/rules view
@@ -1,7 +1,7 @@ #!/usr/bin/make -f  DEB_CABAL_PACKAGE = seereason-darcs-backups-HC = ghc+DEB_DEFAULT_COMPILER = ghc  include /usr/share/cdbs/1/rules/debhelper.mk include /usr/share/cdbs/1/class/hlibrary.mk
test-data/artvaluereport-data/output/debian/control view
@@ -6,8 +6,8 @@                , haskell-devscripts (>= 0.8)                , cdbs                , ghc-               , haskell-hsx-utils                , ghc-prof+               , haskell-hsx-utils                , libghc-extra-dev                , libghc-extra-prof                , libghc-hunit-dev@@ -90,8 +90,6 @@                , libghc-text-prof                , libghc-utf8-string-dev                , libghc-utf8-string-prof-               , libghc-xhtml-dev-               , libghc-xhtml-prof Build-Depends-Indep: ghc-doc                      , libghc-extra-doc                      , libghc-hunit-doc@@ -134,7 +132,6 @@                      , libghc-syb-with-class-doc                      , libghc-text-doc                      , libghc-utf8-string-doc-                     , libghc-xhtml-doc Standards-Version: 3.9.3 Homepage: http://artvaluereportonline.com 
test-data/artvaluereport-data/output/debian/rules view
@@ -1,7 +1,7 @@ #!/usr/bin/make -f  DEB_CABAL_PACKAGE = artvaluereport-data-HC = ghc+DEB_DEFAULT_COMPILER = ghc  include /usr/share/cdbs/1/rules/debhelper.mk include /usr/share/cdbs/1/class/hlibrary.mk
test-data/clckwrks-dot-com/output/debian/rules view
@@ -1,7 +1,7 @@ #!/usr/bin/make -f  DEB_CABAL_PACKAGE = clckwrks-dot-com-HC = ghc+DEB_DEFAULT_COMPILER = ghc  DEB_SETUP_GHC_CONFIGURE_ARGS = -fbackups 
test-data/creativeprompts/output/debian/rules view
@@ -1,7 +1,7 @@ #!/usr/bin/make -f  DEB_CABAL_PACKAGE = creativeprompts-HC = ghc+DEB_DEFAULT_COMPILER = ghc  include /usr/share/cdbs/1/rules/debhelper.mk include /usr/share/cdbs/1/class/hlibrary.mk