module Debian.Debianize.Finalize
( debianize
) where
import OldLens (access, getL)
import Control.Applicative ((<$>))
import Control.Category ((.))
import Control.Monad (unless, when)
import Control.Monad as List (mapM_)
import Control.Monad.State (get, modify)
import Control.Monad.Trans (liftIO, MonadIO)
import Data.ByteString.Lazy.UTF8 (fromString)
import Data.Char (toLower)
import Data.Digest.Pure.MD5 (md5)
import Data.Function (on)
import Data.List as List (filter, intercalate, map, nub, null, unlines, maximumBy)
import Data.Map as Map (delete, elems, insertWith, lookup, Map, toList)
import Data.Maybe (fromMaybe, isJust, isNothing, fromJust)
import Data.Monoid ((<>), mempty)
import Data.Set as Set (difference, filter, fold, fromList, insert, map, null, Set, singleton, toList, union, unions)
import Data.Set.Extra as Set (mapM_)
import Data.Text as Text (intercalate, pack, Text, unlines, unpack)
import Debian.Changes (ChangeLog(..), ChangeLogEntry(..))
import Debian.Debianize.BasicInfo (cabalFlagAssignments, compilerFlavor, verbosity)
import qualified Debian.Debianize.BinaryDebDescription as B
import Debian.Debianize.BuildDependencies (debianBuildDeps, debianBuildDepsIndep)
import qualified Debian.Debianize.CabalInfo as A
import Debian.Debianize.Changelog (dropFutureEntries)
import qualified Debian.Debianize.DebInfo as D
import Debian.Debianize.DebianName (debianName, debianNameBase)
import Debian.Debianize.DebInfo (rulesSettings)
import Debian.Debianize.Goodies (backupAtoms, describe, execAtoms, serverAtoms, siteAtoms, watchAtom)
import Debian.Debianize.InputDebian (dataTop, dataDest, inputChangeLog)
import Debian.Debianize.Monad as Monad (CabalT, liftCabal, unlessM)
import Debian.Debianize.Options (compileCommandlineArgs, compileEnvironmentArgs)
import Debian.Debianize.Prelude ((%=), (+=), (~=), (~?=))
import qualified Debian.Debianize.SourceDebDescription as S
import Debian.Debianize.VersionSplits (DebBase(DebBase))
import Debian.Orphans ()
import Debian.Policy (getCurrentDebianUser, getDebhelperCompatLevel, haskellMaintainer, PackageArchitectures(Any, All), PackagePriority(Extra), parseMaintainer, parseStandardsVersion, Section(..), SourceFormat(Native3, Quilt3))
import Debian.Pretty (PP(..), ppShow)
import Debian.Relation (BinPkgName, BinPkgName(BinPkgName), Relation(Rel), Relations, SrcPkgName(SrcPkgName))
import qualified Debian.Relation as D (BinPkgName(BinPkgName), Relation(..))
import Debian.Release (parseReleaseName)
import Debian.Time (getCurrentLocalRFC822Time)
import qualified Debian.Version as V (buildDebianVersion, DebianVersion, parseDebianVersion, epoch, version, revision)
import Distribution.Compiler (CompilerFlavor(GHC))
#if MIN_VERSION_Cabal(1,22,0)
import Distribution.Compiler (CompilerFlavor(GHCJS))
#endif
import Distribution.Package (Dependency(..), PackageIdentifier(..), PackageName(PackageName))
import Distribution.PackageDescription as Cabal (allBuildInfo, author, BuildInfo(buildable, extraLibs), Executable(buildInfo, exeName), FlagName(FlagName), maintainer, PackageDescription(testSuites))
import qualified Distribution.PackageDescription as Cabal (PackageDescription(dataFiles, executables, library, package))
import Prelude hiding ((.), init, log, map, unlines, unlines, writeFile)
import System.FilePath ((<.>), (</>), makeRelative, splitFileName, takeDirectory, takeFileName)
import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr(..))
import Text.PrettyPrint.HughesPJClass (Pretty(pPrint))
debianize :: (MonadIO m, Functor m) => CabalT m () -> CabalT m ()
debianize customize =
do compileEnvironmentArgs
compileCommandlineArgs
liftCabal inputChangeLog
customize
finalizeDebianization
finalizeDebianization :: (MonadIO m, Functor m) => CabalT m ()
finalizeDebianization =
do date <- liftIO getCurrentLocalRFC822Time
debhelperCompat <- liftIO getDebhelperCompatLevel
finalizeDebianization' date debhelperCompat
vb <- access (A.debInfo . D.flags . verbosity)
when (vb >= 3) (get >>= \ x -> liftIO (putStrLn ("\nFinalized Cabal Info: " ++ show x ++ "\n")))
finalizeDebianization' :: (MonadIO m, Functor m) => String -> Maybe Int -> CabalT m ()
finalizeDebianization' date debhelperCompat =
do
hc <- access (A.debInfo . D.flags . compilerFlavor)
pkgDesc <- access A.packageDescription
testsEnabled <- access (A.debInfo . D.enableTests)
let testsExist = not $ List.null $ Cabal.testSuites pkgDesc
when (testsExist && testsEnabled) $
do (A.debInfo . rulesSettings) %= (++ ["DEB_ENABLE_TESTS = yes"])
unlessM (access (A.debInfo . D.runTests)) $ (A.debInfo . D.rulesSettings) %= (++ ["DEB_BUILD_OPTIONS += nocheck"])
finalizeSourceName B.HaskellSource
checkOfficialSettings hc
addExtraLibDependencies hc
(A.debInfo . D.watch) ~?= Just (watchAtom (pkgName $ Cabal.package $ pkgDesc))
(A.debInfo . D.control . S.section) ~?= Just (MainSection "haskell")
(A.debInfo . D.control . S.priority) ~?= Just Extra
(A.debInfo . D.sourceFormat) ~?= Just Quilt3
(A.debInfo . D.compat) ~?= debhelperCompat
finalizeChangelog date
finalizeControl
finalizeRules
expandAtoms
access (A.debInfo . D.executable) >>= List.mapM_ (cabalExecBinaryPackage . fst) . Map.toList
access (A.debInfo . D.backups) >>= List.mapM_ (cabalExecBinaryPackage . fst) . Map.toList
access (A.debInfo . D.serverInfo) >>= List.mapM_ (cabalExecBinaryPackage . fst) . Map.toList
access (A.debInfo . D.website) >>= List.mapM_ (cabalExecBinaryPackage . fst) . Map.toList
librarySpecs pkgDesc hc
makeUtilsPackage pkgDesc hc
debs <- access (A.debInfo . D.control . S.binaryPackages) >>= return . List.map (getL B.package)
allowSelfDeps <- access (A.debInfo . D.allowDebianSelfBuildDeps)
putBuildDeps (if allowSelfDeps then id else filterRelations debs) pkgDesc
expandAtoms
debianVersion :: (Monad m, Functor m) => CabalT m V.DebianVersion
debianVersion =
do cabalName <- (pkgName . Cabal.package) <$> access A.packageDescription
(cabalVersion :: V.DebianVersion) <- (V.parseDebianVersion . ppShow . pkgVersion . Cabal.package) <$> access A.packageDescription
cabalEpoch <- debianEpoch cabalName
fmt <- access (A.debInfo . D.sourceFormat)
cabalRevision <-
do x <- access (A.debInfo . D.revision)
let y = case x of
Nothing -> Nothing
Just "" -> Nothing
Just "-" -> Nothing
Just ('-':r) -> Just r
Just _ -> error "The --revision argument must start with a dash"
return $ case fmt of
Just Native3 -> y
_ -> maybe (Just "1") (Just . max "1") y
versionArg <- access (A.debInfo . D.debVersion)
(debianVersion :: Maybe V.DebianVersion) <- access (A.debInfo . D.changelog) >>= return . maybe Nothing changelogVersion
case () of
_ | maybe False (\ v -> v < V.buildDebianVersion cabalEpoch (ppShow cabalVersion) Nothing) versionArg ->
error ("Version from --deb-version (" ++ ppShow versionArg ++
") is older than cabal version (" ++ ppShow cabalVersion ++
"), maybe you need to unpin this package?")
_ | isJust versionArg -> return $ fromJust versionArg
_ | isJust debianVersion ->
case (V.epoch (fromJust debianVersion),
V.parseDebianVersion (V.version (fromJust debianVersion)),
V.revision (fromJust debianVersion)) of
(debianEpoch, debianVersion', (debianRevision :: Maybe String)) ->
let finalEpoch = max debianEpoch cabalEpoch
finalVersion = max debianVersion' cabalVersion
(finalRevision :: Maybe String) = maximumBy (compare `on` fmap V.parseDebianVersion) [debianRevision, cabalRevision] in
return $ V.buildDebianVersion finalEpoch (ppShow finalVersion) finalRevision
_ -> return $ V.buildDebianVersion cabalEpoch (ppShow cabalVersion) cabalRevision
changelogVersion :: ChangeLog -> Maybe V.DebianVersion
changelogVersion (ChangeLog (Entry {logVersion = x} : _)) = Just x
changelogVersion _ = Nothing
debianEpoch :: Monad m => PackageName -> CabalT m (Maybe Int)
debianEpoch name = get >>= return . Map.lookup name . getL A.epochMap
finalizeSourceName :: (Monad m, Functor m) => B.PackageType -> CabalT m ()
finalizeSourceName typ =
do DebBase debName <- debianNameBase
(A.debInfo . D.sourcePackageName) ~?= Just (SrcPkgName (case typ of
B.HaskellSource -> "haskell-" ++ debName
B.Source -> debName
_ -> error $ "finalizeSourceName: " ++ show typ))
finalizeMaintainer :: MonadIO m => CabalT m ()
finalizeMaintainer = do
o <- access (A.debInfo . D.official)
currentUser <- liftIO getCurrentDebianUser
pkgDesc <- access A.packageDescription
maintainerOption <- access (A.debInfo . D.maintainerOption)
uploadersOption <- access (A.debInfo . D.uploadersOption)
let cabalAuthorString = takeWhile (\ c -> c /= ',' && c /= '\n') (Cabal.author pkgDesc)
cabalMaintainerString = takeWhile (\ c -> c /= ',' && c /= '\n') (Cabal.maintainer pkgDesc)
cabalMaintainerString' = cabalAuthorString <> " <" <> cabalMaintainerString <> ">"
cabalMaintainerString'' = cabalAuthorString <> " " <> cabalMaintainerString
changelogSignature <-
do log <- access (A.debInfo . D.changelog)
case log of
Just (ChangeLog (entry : _)) ->
case (parseMaintainer (logWho entry)) of
Left _e -> return $ Nothing
Right x -> return (Just x)
_ -> return Nothing
case o of
True -> do
(A.debInfo . D.control . S.maintainer) ~= Just haskellMaintainer
(A.debInfo . D.control . S.uploaders) %= whenEmpty (maybe [] (: []) currentUser)
False -> do
(A.debInfo . D.control . S.maintainer) ~?= maintainerOption
(A.debInfo . D.control . S.maintainer) ~?= (either (const Nothing) Just $ parseMaintainer cabalMaintainerString)
(A.debInfo . D.control . S.maintainer) ~?= (either (const Nothing) Just $ parseMaintainer cabalMaintainerString')
(A.debInfo . D.control . S.maintainer) ~?= (either (const Nothing) Just $ parseMaintainer cabalMaintainerString'')
(A.debInfo . D.control . S.maintainer) ~?= (case parseMaintainer cabalAuthorString of
Right x | nameAddr_addr x == cabalMaintainerString -> Just x
_ -> Nothing)
(A.debInfo . D.control . S.maintainer) ~?= (case parseMaintainer cabalAuthorString of
Right (NameAddr {nameAddr_name = Just name}) -> either (const Nothing) Just (parseMaintainer (name ++ " <" ++ cabalMaintainerString ++ ">"))
_ -> Nothing)
(A.debInfo . D.control . S.maintainer) ~?= currentUser
(A.debInfo . D.control . S.maintainer) ~?= changelogSignature
x <- access (A.debInfo . D.control . S.maintainer)
when (isNothing x)
(do liftIO $ putStrLn ("Unable to construct a debian maintainer, using nobody <nobody@nowhere>. Cabal maintainer strings tried:\n " ++
show cabalMaintainerString ++ ", " ++ show cabalMaintainerString' ++ ", " ++ show cabalMaintainerString'' ++
", currentUser: " ++ show currentUser)
return ())
(A.debInfo . D.control . S.maintainer) ~?= (either (const Nothing) Just $ parseMaintainer "nobody <nobody@nowhere>")
(A.debInfo . D.control . S.uploaders) %= whenEmpty uploadersOption
whenEmpty :: [a] -> [a] -> [a]
whenEmpty d [] = d
whenEmpty _ l = l
finalizeControl :: (MonadIO m, Functor m) => CabalT m ()
finalizeControl =
do finalizeMaintainer
Just src <- access (A.debInfo . D.sourcePackageName)
(A.debInfo . D.control . S.source) ~= Just src
desc' <- describe
(A.debInfo . D.control . S.xDescription) ~?= Just desc'
finalizeChangelog :: (MonadIO m, Functor m) => String -> CabalT m ()
finalizeChangelog date =
do finalizeMaintainer
ver <- debianVersion
src <- access (A.debInfo . D.sourcePackageName)
Just debianMaintainer <- access (A.debInfo . D.control . S.maintainer)
cmts <- access (A.debInfo . D.comments)
(A.debInfo . D.changelog) %= fmap (dropFutureEntries ver)
let msg = "Initial release (Closes: #nnnn)"
(A.debInfo . D.changelog) %= fixLog src ver cmts debianMaintainer msg
where
fixLog :: Maybe SrcPkgName -> V.DebianVersion -> Maybe [[Text]] -> NameAddr -> Text -> Maybe ChangeLog -> Maybe ChangeLog
fixLog src ver cmts _maint _ (Just (ChangeLog (entry : older)))
| logVersion entry == ver =
let entry' = entry { logPackage = show (pPrint (PP src))
, logComments = logComments entry ++ "\n" ++
(List.unlines $ List.map ((" * " <>) . List.intercalate "\n " . List.map unpack) (fromMaybe [] cmts))
} in
Just (ChangeLog (entry' : older))
fixLog src ver cmts maint msg log =
let entry = Entry { logPackage = show (pPrint (PP src))
, logVersion = ver
, logDists = [parseReleaseName "UNRELEASED"]
, logUrgency = "low"
, logComments =
List.unlines $ List.map ((" * " <>) . List.intercalate "\n " . List.map unpack) (fromMaybe [[msg]] cmts)
, logWho = ppShow maint
, logDate = date } in
Just (ChangeLog (entry : maybe [] (\ (ChangeLog entries) -> entries) log))
addExtraLibDependencies :: (Monad m, Functor m) => CompilerFlavor -> CabalT m ()
addExtraLibDependencies hc =
do pkgDesc <- access A.packageDescription
devName <- debianName B.Development hc
libMap <- access (A.debInfo . D.extraLibMap)
binNames <- List.map (getL B.package) <$> access (A.debInfo . D.control . S.binaryPackages)
when (any (== devName) binNames) ((A.debInfo . D.binaryDebDescription devName . B.relations . B.depends) %= \ deps -> deps ++ g pkgDesc libMap)
where
g :: PackageDescription -> Map String Relations -> Relations
g pkgDesc libMap = concatMap (devDep libMap) (nub $ concatMap Cabal.extraLibs $ Cabal.allBuildInfo $ pkgDesc)
devDep :: Map String Relations -> String -> Relations
devDep libMap cab = maybe [[Rel (BinPkgName ("lib" ++ cab ++ "-dev")) Nothing Nothing]] id (Map.lookup cab libMap)
checkOfficialSettings :: (Monad m, Functor m) => CompilerFlavor -> CabalT m ()
checkOfficialSettings flavor =
do o <- access (A.debInfo . D.official)
when o $ case flavor of
GHC -> officialSettings
_ -> error $ "There is no official packaging for " ++ show flavor
officialSettings :: (Monad m, Functor m) => CabalT m ()
officialSettings =
do pkgDesc <- access A.packageDescription
let PackageName cabal = pkgName (Cabal.package pkgDesc)
(A.debInfo . D.control . S.standardsVersion) ~?= Just (parseStandardsVersion "3.9.6")
(A.debInfo . D.control . S.homepage) ~?= Just ("http://hackage.haskell.org/package/" <> pack cabal)
(A.debInfo . D.omitProfVersionDeps) ~= True
SrcPkgName src <- access (A.debInfo . D.sourcePackageName) >>= maybe (error "officialSettings: no sourcePackageName") return
(A.debInfo . D.control . S.vcsFields) %= Set.union (Set.fromList
[ S.VCSBrowser $ "http://darcs.debian.org/cgi-bin/darcsweb.cgi?r=pkg-haskell/" <> pack src
, S.VCSDarcs $ "http://darcs.debian.org/pkg-haskell/" <> pack src
])
putBuildDeps :: (MonadIO m, Functor m) => (Relations -> Relations) -> PackageDescription -> CabalT m ()
putBuildDeps finalizeRelations pkgDesc =
do deps <- debianBuildDeps pkgDesc >>= return . finalizeRelations
depsIndep <- debianBuildDepsIndep pkgDesc >>= return . finalizeRelations
(A.debInfo . D.control . S.buildDepends) ~= deps
(A.debInfo . D.control . S.buildDependsIndep) ~= depsIndep
filterRelations :: [BinPkgName] -> Relations -> Relations
filterRelations badNames orRels =
List.filter (not . List.null) (List.map filterOrRelation orRels)
where
filterOrRelation :: [Relation] -> [Relation]
filterOrRelation rels = List.filter (\ (Rel name _ _) -> not (elem name badNames)) rels
cabalExecBinaryPackage :: Monad m => BinPkgName -> CabalT m ()
cabalExecBinaryPackage b =
do (A.debInfo . D.binaryDebDescription b . B.packageType) ~?= Just B.Exec
(A.debInfo . D.binaryDebDescription b . B.architecture) ~?= Just Any
(A.debInfo . D.binaryDebDescription b . B.binarySection) ~?= Just (MainSection "misc")
(A.debInfo . D.binaryDebDescription b . B.description) ~?= Just desc
binaryPackageRelations b B.Exec
where
binaryPackageRelations :: Monad m => BinPkgName -> B.PackageType -> CabalT m ()
binaryPackageRelations b typ =
do edds <- access (A.debInfo . D.extraDevDeps)
(A.debInfo . D.binaryDebDescription b . B.relations . B.depends) %= \ rels ->
[anyrel "${haskell:Depends}", anyrel "${misc:Depends}"] ++
[anyrel "${shlibs:Depends}" | typ `notElem` [B.Profiling, B.Documentation] ] ++
edds ++ rels
(A.debInfo . D.binaryDebDescription b . B.relations . B.recommends) %= \ rels -> [anyrel "${haskell:Recommends}"] ++ rels
(A.debInfo . D.binaryDebDescription b . B.relations . B.suggests) %= \ rels -> [anyrel "${haskell:Suggests}"] ++ rels
(A.debInfo . D.binaryDebDescription b . B.relations . B.preDepends) ~= []
(A.debInfo . D.binaryDebDescription b . B.relations . B.breaks) ~= []
(A.debInfo . D.binaryDebDescription b . B.relations . B.conflicts) %= \ rels -> [anyrel "${haskell:Conflicts}"] ++ rels
(A.debInfo . D.binaryDebDescription b . B.relations . B.provides) %= \ rels -> (if typ /= B.Documentation then [anyrel "${haskell:Provides}"] else []) ++ rels
(A.debInfo . D.binaryDebDescription b . B.relations . B.builtUsing) ~= []
librarySpecs :: (Monad m, Functor m) => PackageDescription -> CompilerFlavor -> CabalT m ()
librarySpecs pkgDesc hc =
do let dev = isJust (Cabal.library pkgDesc)
doc <- get >>= return . not . getL (A.debInfo . D.noDocumentationLibrary)
prof <- get >>= return . not . getL (A.debInfo . D.noProfilingLibrary)
when dev (librarySpec Any B.Development hc)
when (dev && prof && hc == GHC) (librarySpec Any B.Profiling hc)
when (dev && doc) (docSpecsParagraph hc)
docSpecsParagraph :: (Monad m, Functor m) => CompilerFlavor -> CabalT m ()
docSpecsParagraph hc =
do b <- debianName B.Documentation hc
binaryPackageRelations b B.Documentation
(A.debInfo . D.binaryDebDescription b . B.packageType) ~?= Just B.Documentation
(A.debInfo . D.binaryDebDescription b . B.packageType) ~?= Just B.Documentation
(A.debInfo . D.binaryDebDescription b . B.architecture) ~= Just All
(A.debInfo . D.binaryDebDescription b . B.binarySection) ~?= Just (MainSection "doc")
(A.debInfo . D.binaryDebDescription b . B.description) ~?= Just desc
librarySpec :: (Monad m, Functor m) => PackageArchitectures -> B.PackageType -> CompilerFlavor -> CabalT m ()
librarySpec arch typ hc =
do b <- debianName typ hc
binaryPackageRelations b typ
(A.debInfo . D.binaryDebDescription b . B.packageType) ~?= Just typ
(A.debInfo . D.binaryDebDescription b . B.packageType) ~?= Just typ
(A.debInfo . D.binaryDebDescription b . B.architecture) ~?= Just arch
(A.debInfo . D.binaryDebDescription b . B.description) ~?= Just desc
desc :: Text
desc = Text.intercalate "\n "
["${haskell:ShortDescription}${haskell:ShortBlurb}",
"${haskell:LongDescription}",
".",
"${haskell:Blurb}"]
makeUtilsPackage :: forall m. (MonadIO m, Functor m) => PackageDescription -> CompilerFlavor -> CabalT m ()
makeUtilsPackage pkgDesc hc =
do
installedDataMap <- Set.fold (\ x r ->
case x of
D.Install b from _ -> Map.insertWith Set.union b (singleton from) r
D.InstallTo b from _ -> Map.insertWith Set.union b (singleton from) r
D.InstallData b from _ -> Map.insertWith Set.union b (singleton from) r
_ -> r) mempty <$> access (A.debInfo . D.atomSet) :: CabalT m (Map BinPkgName (Set FilePath))
installedExecMap <- Set.fold (\ x r ->
case x of
D.InstallCabalExec b name _ -> Map.insertWith Set.union b (singleton name) r
D.InstallCabalExecTo b name _ -> Map.insertWith Set.union b (singleton name) r
_ -> r) mempty <$> access (A.debInfo . D.atomSet) :: CabalT m (Map BinPkgName (Set String))
insExecPkg <- access (A.debInfo . D.executable) >>= return . Set.map ename . Set.fromList . elems
let installedData = Set.map (\ a -> (a, a)) $ Set.unions (Map.elems installedDataMap)
installedExec = Set.unions (Map.elems installedExecMap)
prefixPath <- dataTop
let dataFilePaths = Set.fromList (zip (List.map (prefixPath </>) (Cabal.dataFiles pkgDesc)) (Cabal.dataFiles pkgDesc)) :: Set (FilePath, FilePath)
execFilePaths = Set.map Cabal.exeName (Set.filter (Cabal.buildable . Cabal.buildInfo) (Set.fromList (Cabal.executables pkgDesc))) :: Set FilePath
let availableData = Set.union installedData dataFilePaths
availableExec = Set.union installedExec execFilePaths
access (A.debInfo . D.utilsPackageNameBase) >>= \ name ->
case name of
Nothing -> debianName B.Utilities hc >>= \ (BinPkgName name') -> (A.debInfo . D.utilsPackageNameBase) ~= Just name'
_ -> return ()
b <- debianName B.Utilities hc
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
let utilsData = Set.difference availableData installedDataOther
utilsExec = Set.difference availableExec installedExecOther
let utilsDataMissing = Set.difference utilsData installedData
utilsExecMissing = Set.difference utilsExec installedExec
when (not (Set.null utilsData && Set.null utilsExec)) $ do
(A.debInfo . D.binaryDebDescription b . B.description) ~?= Just desc
(A.debInfo . D.rulesFragments)+= (pack ("build" </> ppShow b ++ ":: build-ghc-stamp\n"))
(A.debInfo . D.binaryDebDescription b . B.architecture) ~?= Just (if Set.null utilsExec then All else Any)
(A.debInfo . D.binaryDebDescription b . B.binarySection) ~?= Just (MainSection "misc")
binaryPackageRelations b B.Utilities
Set.mapM_ (\ (foo, bar) -> (A.debInfo . D.atomSet) %= (Set.insert $ D.InstallData b foo bar)) utilsDataMissing
Set.mapM_ (\ name -> (A.debInfo . D.atomSet) %= (Set.insert $ D.InstallCabalExec b name "usr/bin")) utilsExecMissing
where
ename i =
case D.sourceDir i of
(Nothing) -> D.execName i
(Just s) -> s </> D.execName i
expandAtoms :: MonadIO m => CabalT m ()
expandAtoms =
do hc <- access (A.debInfo . D.flags . compilerFlavor)
case hc of
GHC -> (A.debInfo . D.flags . cabalFlagAssignments) %= (Set.union (Set.fromList (flagList "--ghc")))
#if MIN_VERSION_Cabal(1,22,0)
GHCJS -> (A.debInfo . D.flags . cabalFlagAssignments) %= (Set.union (Set.fromList (flagList "--ghcjs")))
#endif
builddir <- access (A.debInfo . D.buildDir) >>= return . fromMaybe (case hc of
GHC -> "dist-ghc/build"
#if MIN_VERSION_Cabal(1,22,0)
GHCJS -> "dist-ghcjs/build"
#endif
_ -> error $ "Unexpected compiler: " ++ show hc)
dDest <- dataDest
expandApacheSites
expandInstallCabalExecs builddir
expandInstallCabalExecTo builddir
expandInstallData dDest
expandInstallTo
expandFile
expandWebsite
expandServer
expandBackups
expandExecutable
where
expandApacheSites :: Monad m => CabalT m ()
expandApacheSites =
do mp <- get >>= return . getL (A.debInfo . D.apacheSite)
List.mapM_ expandApacheSite (Map.toList mp)
where
expandApacheSite (b, (dom, log, text)) =
do (A.debInfo . D.atomSet) %= (Set.insert $ D.Link b ("/etc/apache2/sites-available/" ++ dom) ("/etc/apache2/sites-enabled/" ++ dom))
(A.debInfo . D.atomSet) %= (Set.insert $ D.InstallDir b log)
(A.debInfo . D.atomSet) %= (Set.insert $ D.File b ("/etc/apache2/sites-available" </> dom) text)
expandInstallCabalExecs :: Monad m => FilePath -> CabalT m ()
expandInstallCabalExecs builddir = do
hc <- access (A.debInfo . D.flags . compilerFlavor)
access (A.debInfo . D.atomSet) >>= Set.mapM_ (doAtom hc)
where
doAtom :: Monad m => CompilerFlavor -> D.Atom -> CabalT m ()
doAtom GHC (D.InstallCabalExec b name dest) = (A.debInfo . D.atomSet) %= (Set.insert $ D.Install b (builddir </> name </> name) dest)
#if MIN_VERSION_Cabal(1,22,0)
doAtom GHCJS (D.InstallCabalExec b name dest) =
(A.debInfo . D.rulesFragments) +=
(Text.unlines
[ pack ("binary-fixup" </> ppShow b) <> "::"
, pack ("\t(cd " <> builddir </> name <> " && find " <> name <.> "jsexe" <> " -type f) |\\\n" <>
"\t while read i; do install -Dp " <> builddir </> name </> "$$i debian" </> ppShow b </> makeRelative "/" dest </> "$$i; done\n") ])
#endif
doAtom _ _ = return ()
expandInstallCabalExecTo :: Monad m => FilePath -> CabalT m ()
expandInstallCabalExecTo builddir = do
hc <- access (A.debInfo . D.flags . compilerFlavor)
access (A.debInfo . D.atomSet) >>= Set.mapM_ (doAtom hc)
where
doAtom :: Monad m => CompilerFlavor -> D.Atom -> CabalT m ()
doAtom GHC (D.InstallCabalExecTo b name dest) =
(A.debInfo . D.rulesFragments) +=
(Text.unlines
[ pack ("binary-fixup" </> ppShow b) <> "::"
, "\tinstall -Dps " <> pack (builddir </> name </> name) <> " "
<> pack ("debian" </> ppShow b </> makeRelative "/" dest) ])
doAtom hc (D.InstallCabalExecTo b name dest) = error $ "expandInstallCabalExecTo " ++ show hc ++ " " ++ show (D.InstallCabalExecTo b name dest)
doAtom _ _ = return ()
expandInstallData :: Monad m => FilePath -> CabalT m ()
expandInstallData dDest =
access (A.debInfo . D.atomSet) >>= List.mapM_ doAtom . Set.toList
where
doAtom :: Monad m => D.Atom -> CabalT m ()
doAtom (D.InstallData b from dest) =
if takeFileName from == takeFileName dest
then (A.debInfo . D.atomSet) %= (Set.insert $ D.Install b from (dDest </> makeRelative "/" (takeDirectory dest)))
else (A.debInfo . D.atomSet) %= (Set.insert $ D.InstallTo b from (dDest </> makeRelative "/" dest))
doAtom _ = return ()
expandInstallTo :: Monad m => CabalT m ()
expandInstallTo =
access (A.debInfo . D.atomSet) >>= List.mapM_ doAtom . Set.toList
where
doAtom :: Monad m => D.Atom -> CabalT m ()
doAtom (D.InstallTo b from dest) =
(A.debInfo . D.rulesFragments) +=
(Text.unlines [ pack ("binary-fixup" </> ppShow b) <> "::"
, "\tinstall -Dp " <> pack from <> " " <> pack ("debian" </> ppShow b </> makeRelative "/" dest) ])
doAtom _ = return ()
expandFile :: Monad m => CabalT m ()
expandFile =
access (A.debInfo . D.atomSet) >>= List.mapM_ doAtom . Set.toList
where
doAtom :: Monad m => D.Atom -> CabalT m ()
doAtom (D.File b path text) =
do let (destDir', destName') = splitFileName path
tmpDir = "debian/cabalInstall" </> show (md5 (fromString (unpack text)))
tmpPath = tmpDir </> destName'
(A.debInfo . D.intermediateFiles) += (tmpPath, text)
(A.debInfo . D.atomSet) %= (Set.insert $ D.Install b tmpPath destDir')
doAtom _ = return ()
expandWebsite :: Monad m => CabalT m ()
expandWebsite =
do mp <- get >>= return . getL (A.debInfo . D.website)
List.mapM_ (\ (b, site) -> modify (siteAtoms b site)) (Map.toList mp)
expandServer :: Monad m => CabalT m ()
expandServer =
do mp <- get >>= return . getL (A.debInfo . D.serverInfo)
List.mapM_ (\ (b, x) -> modify (serverAtoms b x False)) (Map.toList mp)
expandBackups :: Monad m => CabalT m ()
expandBackups =
do mp <- get >>= return . getL (A.debInfo . D.backups)
List.mapM_ (\ (b, name) -> modify (backupAtoms b name)) (Map.toList mp)
expandExecutable :: Monad m => CabalT m ()
expandExecutable =
do mp <- get >>= return . getL (A.debInfo . D.executable)
List.mapM_ (\ (b, f) -> modify (execAtoms b f)) (Map.toList mp)
finalizeRules :: (Monad m, Functor m) => CabalT m ()
finalizeRules =
do DebBase b <- debianNameBase
compiler <- access (A.debInfo . D.flags . compilerFlavor)
(A.debInfo . D.rulesHead) ~?= Just "#!/usr/bin/make -f"
(A.debInfo . D.rulesSettings) %= (++ ["DEB_CABAL_PACKAGE = " <> pack b])
(A.debInfo . D.rulesSettings) %= (++ (["DEB_DEFAULT_COMPILER = " <> pack (List.map toLower (show compiler))]))
flags <- (flagString . Set.toList) <$> access (A.debInfo . D.flags . cabalFlagAssignments)
unless (List.null flags) ((A.debInfo . D.rulesSettings) %= (++ ["DEB_SETUP_GHC6_CONFIGURE_ARGS = " <> pack flags]))
(A.debInfo . D.rulesIncludes) %= (++ ["include /usr/share/cdbs/1/rules/debhelper.mk",
"include /usr/share/cdbs/1/class/hlibrary.mk"])
data Dependency_
= BuildDepends Dependency
| BuildTools Dependency
| PkgConfigDepends Dependency
| ExtraLibs Relations
deriving (Eq, Show)
anyrel :: String -> [D.Relation]
anyrel x = anyrel' (D.BinPkgName x)
anyrel' :: D.BinPkgName -> [D.Relation]
anyrel' x = [D.Rel x Nothing Nothing]
flagList :: String -> [(FlagName, Bool)]
flagList = List.map tagWithValue . words
where tagWithValue ('-':name) = (FlagName (List.map toLower name), False)
tagWithValue name = (FlagName (List.map toLower name), True)
flagString :: [(FlagName, Bool)] -> String
flagString = List.intercalate " " . List.map (\ (FlagName s, sense) -> "-f" ++ (if sense then "" else "-") ++ s)