diff --git a/debian-build.cabal b/debian-build.cabal --- a/debian-build.cabal +++ b/debian-build.cabal @@ -1,5 +1,5 @@ name: debian-build -version: 0.4.0.1 +version: 0.4.1.0 synopsis: Debian package build sequence tools description: This package provides build sequence functions for debian package, and includes on-the-fly @@ -32,6 +32,7 @@ , process , directory , transformers + , split , Cabal hs-source-dirs: src diff --git a/mains/odebuild.hs b/mains/odebuild.hs --- a/mains/odebuild.hs +++ b/mains/odebuild.hs @@ -1,24 +1,27 @@ import System.Environment (getProgName, getArgs) -import Control.Monad (void) +import Control.Monad (void, when) import Data.List (stripPrefix) -import Debian.Package.Data (Source, Hackage) +import Debian.Package.Data (Source, Hackage, isBinaryChanges) import Debian.Package.Build - (BuildMode (Bin, Src), buildPackage, debi, + (BuildMode (Dep, Indep, Src), buildPackage, debi', baseDirCurrent, defaultConfig, Build, runBuild, liftTrace, - sourceDir, removeBuildDir, genSources, removeGhcLibrary) + removeBuildDir, findDebianChanges, genSources, removeGhcLibrary) defualtModes :: [BuildMode] -defualtModes = [Bin, Src] +defualtModes = [Dep, Indep, Src] remove' :: Hackage -> Build () remove' hkg = liftTrace $ sequence_ [removeGhcLibrary m hkg | m <- defualtModes] -install' :: Source -> Build () -install' src = do - srcDir <- sourceDir src - liftTrace $ debi srcDir [] +install' :: Build () +install' = do + ps <- findDebianChanges + let cs = [c | (c, t) <- ps, isBinaryChanges t ] + liftTrace $ do + when (null cs) $ fail "No .changes files found!" + mapM_ (\c -> debi' [c]) cs help :: IO () @@ -51,14 +54,14 @@ install :: Maybe String -> [String] -> Build () install mayRev args = do - (src, _mayH) <- build mayRev args - install' src + void $ build mayRev args + install' reinstall :: Maybe String -> [String] -> Build () reinstall mayRev args = do - (src, mayH) <- build mayRev args + (_src, mayH) <- build mayRev args maybe (return ()) remove' mayH - install' src + install' run :: Build a -> IO a run b = uncurry (runBuild b baseDirCurrent) defaultConfig diff --git a/src/Debian/Package/Build/Command.hs b/src/Debian/Package/Build/Command.hs --- a/src/Debian/Package/Build/Command.hs +++ b/src/Debian/Package/Build/Command.hs @@ -19,7 +19,7 @@ , cabalDebian', cabalDebian, packageVersion, dpkgParseChangeLog - , debuild, debi + , debuild, debi', debi , BuildMode (..) @@ -192,9 +192,13 @@ debuild :: FilePath -> [String] -> Trace () debuild dir = withCurrentDir' dir . debuild' +-- | Just run debi with root user +debi' :: [String] -> Trace () +debi' = rawSystem' . (["sudo", "debi"] ++) + -- | Install packages under specified source package directory debi :: FilePath -> [String] -> Trace () -debi dir = withCurrentDir' dir . rawSystem' . (["sudo", "debi"] ++) +debi dir = withCurrentDir' dir . debi' -- | Build mode, all or binary only data BuildMode = All | Bin | Src | Dep | Indep diff --git a/src/Debian/Package/Build/Monad.hs b/src/Debian/Package/Build/Monad.hs --- a/src/Debian/Package/Build/Monad.hs +++ b/src/Debian/Package/Build/Monad.hs @@ -139,7 +139,12 @@ -- | Default configuration defaultConfig :: (Config, Bool) -defaultConfig = (Config (buildDirRelative ".debian-build") "debian" [".git", ".hg"], True) +defaultConfig = (Config + { buildDir = buildDirRelative ".debian-build" + , debianDirName = "debian" + , sourceExcludes = [".git", ".hg"] + }, + True) -- | Monad type with build base directory and build configuration. type Build = ReaderT BaseDir (ReaderT Config Trace) diff --git a/src/Debian/Package/Build/Sequence.hs b/src/Debian/Package/Build/Sequence.hs --- a/src/Debian/Package/Build/Sequence.hs +++ b/src/Debian/Package/Build/Sequence.hs @@ -13,7 +13,8 @@ , withCurrentDir, withBaseCurrentDir - , removeBuildDir + , getBuildDir, removeBuildDir + , findDebianChanges , copyDebianDir @@ -26,17 +27,19 @@ import System.FilePath ((), takeFileName, takeDirectory, takeBaseName) import System.Directory - (doesDirectoryExist, doesFileExist) + (getDirectoryContents, doesDirectoryExist, doesFileExist) import Control.Applicative (pure, (<$>), (<*>), (<|>)) import Control.Monad (when) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Maybe (MaybeT(MaybeT), runMaybeT) import Data.List (isPrefixOf) +import Data.Maybe (catMaybes) import Debian.Package.Data (Hackage, hackageLongName, hackageArchive, Source, origArchiveName, nativeArchiveName, sourceDirName, isNative, + ChangesType, takeChangesType, HaskellPackage, hackage, package, haskellPackageFromPackage) import Debian.Package.Build.Monad (Build, liftTrace, bracketBuild_, Config (..), askConfig, askBaseDir, askBuildDir) @@ -65,7 +68,7 @@ baseDir <- getBaseDir withCurrentDir baseDir act --- Take build-directory from 'Build' action context. +-- | Take build-directory from 'Build' action context. getBuildDir :: Build FilePath getBuildDir = liftIO pwd >>= askBuildDir @@ -232,6 +235,17 @@ return $ if exist then Just changelog else Nothing + +-- | Find debian .changes files +findDebianChanges :: Build [(FilePath, ChangesType)] +findDebianChanges = do + bd <- getBuildDir + fs <- liftIO $ getDirectoryContents bd + return $ catMaybes + [ do ty <- takeChangesType path + Just (path, ty) + | path <- map (bd ) fs + ] findCabalDescription :: MaybeT Build FilePath findCabalDescription = MaybeT (getBaseDir >>= liftIO . Cabal.findDescriptionFile) diff --git a/src/Debian/Package/Data/Source.hs b/src/Debian/Package/Data/Source.hs --- a/src/Debian/Package/Data/Source.hs +++ b/src/Debian/Package/Data/Source.hs @@ -17,20 +17,23 @@ , parseChangeLog + , ChangesType (..), takeChangesType, isSourceChanges, isBinaryChanges + , HaskellPackage, hackage, package , haskellPackageDefault, haskellPackageFromPackage ) where -import Data.Maybe (listToMaybe) import Control.Arrow (second) import Control.Applicative ((<$>), pure, (<*>), (<|>)) import Control.Monad.Trans.State (StateT, runStateT) import Control.Monad.Trans.Class (lift) import Numeric (readDec) +import Data.Maybe (listToMaybe) import Data.Char (isSpace) import Data.Version (Version (Version, versionBranch), showVersion, parseVersion) +import Data.List.Split (splitOn) import Text.ParserCombinators.ReadP (ReadP, string, readP_to_S, readS_to_P) -import System.FilePath ((<.>)) +import System.FilePath ((<.>), takeFileName, splitExtension) import Debian.Package.Data.Hackage (HackageVersion, mkHackageVersion', hackageVersionNumbers, @@ -169,6 +172,36 @@ mayDebVer = do dverS <- lookup' "Version:" readDebianVersion dverS + +-- | Debian .changes file types +data ChangesType + = ChangesArch String + | ChangesAll + | ChangesSource + deriving (Eq, Show) + +-- | Take 'ChangesType' from debian .changes file path +takeChangesType :: FilePath -> Maybe ChangesType +takeChangesType path = d . splitExtension $ takeFileName path where + d (n, ".changes") = case xs of + [_, _, a] -> case a of + "all" -> Just ChangesAll + "source" -> Just ChangesSource + _ -> Just $ ChangesArch a + _ -> Nothing + where xs = splitOn "_" n + d (_, _) = Nothing + +-- | Test changes file type is source package. +isSourceChanges :: ChangesType -> Bool +isSourceChanges = d where + d (ChangesArch _) = False + d ChangesAll = False + d ChangesSource = True + +-- | Test changes file type is binary package. +isBinaryChanges :: ChangesType -> Bool +isBinaryChanges = not . isSourceChanges -- | Debian source package type for Haskell