diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,16 @@ +# 2.3.0 (2025-02-23) +- refactor all head/tail usage to safe functions (headMay and tailSafe) +- spec: explicit url +- spec: html entity decoding of description +- spec: simplify name and binlib logic +- spec: use %bcond to enable tests rather than %bcond_without +- spec: use -w for cabal update +- spec: use available source manpages +- Dependencies: add rts to excludedPkgs +- Dependencies: filter excludedTools from testToolDeps +- readStream replaces Read Stream for better error +- initial testsuite + # 2.2.1 (2024-08-02) - getBuildDir: handle new rpm-4.20 BUILD/n-v-build dir - spec: --stream should be used first when determining stream diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -72,7 +72,7 @@ `$ cabal-rpm --version` ``` -2.2.1 +2.3.0 ``` `$ cabal-rpm --help` diff --git a/cabal-rpm.cabal b/cabal-rpm.cabal --- a/cabal-rpm.cabal +++ b/cabal-rpm.cabal @@ -1,6 +1,6 @@ Cabal-version: 1.18 Name: cabal-rpm -Version: 2.2.1 +Version: 2.3.0 Synopsis: RPM packaging tool for Haskell Cabal-based packages Description: This package provides a RPM packaging tool for Haskell Cabal-based @@ -45,12 +45,14 @@ Main-is: Main.hs Build-depends: base < 5, aeson, - Cabal > 1.10 && < 3.11, + Cabal > 1.10 && < 3.15, cached-json-file, directory, extra, filepath >= 1.4, + html-entities, http-query, + safe, simple-cabal >= 0.1.3, simple-cmd >= 0.2.3, simple-cmd-args >= 0.1.7, @@ -88,16 +90,16 @@ Paths_cabal_rpm Hs-Source-Dirs: src ghc-options: -fwarn-missing-signatures -Wall - if impl(ghc >= 8.0) - ghc-options: -Wcompat - -Widentities - -Wincomplete-uni-patterns - -Wincomplete-record-updates - -Wredundant-constraints - if impl(ghc >= 8.2) - ghc-options: -fhide-source-paths - if impl(ghc >= 8.4) - ghc-options: -Wmissing-export-lists - -Wpartial-fields - if impl(ghc >= 8.10) - ghc-options: -Wunused-packages + if impl(ghc >= 8.0) + ghc-options: -Wcompat + -Widentities + -Wincomplete-uni-patterns + -Wincomplete-record-updates + -Wredundant-constraints + if impl(ghc >= 8.2) + ghc-options: -fhide-source-paths + if impl(ghc >= 8.4) + ghc-options: -Wmissing-export-lists + -Wpartial-fields + if impl(ghc >= 8.10) + ghc-options: -Wunused-packages diff --git a/src/Commands/Diff.hs b/src/Commands/Diff.hs --- a/src/Commands/Diff.hs +++ b/src/Commands/Diff.hs @@ -32,7 +32,7 @@ import SimpleCmd (grep_, error', pipe) import System.FilePath ((<.>)) import System.IO.Extra (withTempDir) -import System.Posix.Env (getEnvDefault) +import System.Posix.Env (getEnv) diff :: Flags -> PackageType -> Maybe PackageVersionSpecifier -> IO () diff flags pkgtype mpvs = do @@ -46,8 +46,13 @@ currel <- getSpecField "Release" spec let suffix = "%{?dist}" editSpecField "Release" (currel ++ suffix) speccblrpm - diffcmd <- words <$> getEnvDefault "CBLRPM_DIFF" "diff -u" - out <- dropChangelog <$> pipe (head diffcmd, tail diffcmd ++ [spec, speccblrpm]) + mdiffcmd <- getEnv "CBLRPM_DIFF" + let (diffc,diffargs) = + case words <$> mdiffcmd of + Nothing -> ("diff", ["-u"]) + Just (c:args) -> (c,args) + _ -> error' "CBLRPM_DIFF is ill-defined" + out <- dropChangelog <$> pipe (diffc, diffargs ++ [spec, speccblrpm]) ---- was for %autorelease: -- out <- pipe (head diffcmd, tail diffcmd ++ [spec, speccblrpm]) ("sed", ["-e", "s%" ++ speccblrpm ++ "%" ++ spec <.> "cblrpm" ++ "%"]) diff --git a/src/Commands/Spec.hs b/src/Commands/Spec.hs --- a/src/Commands/Spec.hs +++ b/src/Commands/Spec.hs @@ -26,9 +26,9 @@ prettyShow, recurseMissing, subPackages, testsuiteDependencies') import Header (headerOption, withSpecHead) -import PackageUtils (dependencySortCabals, PackageData (..), prepare, - packageMacro) -import SimpleCabal (buildable, mkPackageName, PackageDescription (..), +import PackageUtils (builtExecs, dependencySortCabals, PackageData (..), + packageMacro, prepare) +import SimpleCabal (mkPackageName, PackageDescription (..), PackageIdentifier(..)) import SimpleCmd ((+-+), cmd, cmdLines, cmdMaybe, grep, grep_, removePrefix) import Types @@ -42,38 +42,37 @@ import Data.Char (toUpper) import Data.List.Extra import Data.Maybe (isJust, isNothing, fromMaybe, fromJust) +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Builder as TLB import Data.Time.Clock (getCurrentTime) import Data.Time.Format (defaultTimeLocale, formatTime) import qualified Data.Version as V import Distribution.PackageDescription ( - Executable (buildInfo), - Library (exposedModules), exeName, + Library (exposedModules), hasExes, hasLibs, #if MIN_VERSION_Cabal(2,2,0) license, #endif ) - import Distribution.Simple.Utils (warn) import Distribution.Text (display) - #if MIN_VERSION_Cabal(2,0,0) import Distribution.Types.UnqualComponentName (unUnqualComponentName) #endif +#if MIN_VERSION_Cabal(3,2,0) +import qualified Distribution.Utils.ShortText as ST (fromShortText) +#endif import Distribution.Verbosity (Verbosity) +import qualified HTMLEntities.Decoder as HD import System.Directory (doesFileExist) import System.IO (IOMode (..), hClose, hPutStrLn, openFile) -import System.FilePath (takeBaseName, (), (<.>)) +import System.FilePath (takeBaseName, takeFileName, (), (<.>)) import qualified Paths_cabal_rpm (version) -#if MIN_VERSION_Cabal(3,2,0) -import qualified Distribution.Utils.ShortText as ST (fromShortText) -#endif - - #if !MIN_VERSION_Cabal(2,0,0) unUnqualComponentName :: String -> String unUnqualComponentName = id @@ -91,6 +90,7 @@ _ -> specFilename pkgdata docs = docFilenames pkgdata licensefiles = licenseFilenames pkgdata + manpages = manpageFiles pkgdata pkgDesc = packageDesc pkgdata pkgid = package pkgDesc name = display $ pkgName pkgid @@ -146,14 +146,14 @@ ghc_name = if isJust mwithghc then "%{ghc_name}" else "ghc" majorVer = V.showVersion . V.makeVersion . take 2 . V.versionBranch ghcname = "ghc" ++ maybe "" majorVer mwithghc - -- FIXME is binlib misnamed? - (pkgname, binlib) <- getPkgName mspec ghcname pkgDesc (pkgtype == BinaryPkg || standalone) + -- binlib means package shipping both exe and proper lib + (pkgname, binlib) <- getPkgName mspec ghcname pkgDesc (pkgtype == BinaryPkg) hasLibPkg let pkg_name = if pkgname == name then "%{name}" else "%{pkg_name}" + hasExecPkg = binlib || (hasExec && not hasLibPkg) basename | binlib = "%{pkg_name}" | hasExecPkg = name | otherwise = ghc_name ++ "-%{pkg_name}" targetSpecFile = fromMaybe "" mdest pkgname <.> "spec" - hasExecPkg = binlib || (hasExec && not hasLibPkg) targetSpecAlreadyExists <- doesFileExist targetSpecFile -- run commands before opening file to prevent empty file on error -- maybe shell commands should be in a monad or something @@ -184,7 +184,7 @@ Just (PVPackageId _) -> return Nothing _ -> case mspec of Just spec -> - withSpecHead spec (return . fmap read . headerOption "--stream") + withSpecHead spec (return . fmap readStream . headerOption "--stream") Nothing -> return Nothing h <- openFile outputFile WriteMode @@ -229,7 +229,7 @@ #endif description pkgDesc when (null descr) $ warn verbose "this package has no description." - let descLines = (formatParagraphs . initialCapital . filterSymbols . finalPeriod . paragraphPeriods) $ if null descr then syn' else descr + let descLines = (formatParagraphs . initialCapital . filterSymbols . finalPeriod . paragraphPeriods . htmlEntityDecode) $ if null descr then syn' else descr paragraphPeriods = unlines . map (\l -> if l == "." then "" else l) . lines finalPeriod cs = @@ -239,13 +239,12 @@ _ -> cs ++ "." filterSymbols [] = [] filterSymbols (c:cs) = - if c `notElem` "@\\" - then c: filterSymbols cs - else - case c of - '@' -> '\'': filterSymbols cs - '\\' -> head cs: filterSymbols (tail cs) - _ -> c: filterSymbols cs + case c of + '@' -> '\'' : filterSymbols cs + '\\' -> case cs of + (c':cs') -> c': filterSymbols cs' + "" -> "" + _ -> c : filterSymbols cs when standalone $ do global "ghc_without_dynamic" "1" @@ -257,14 +256,14 @@ global "debug_package" "%{nil}" putNewline - when hasLib $ do + when hasLibPkg $ do global "pkg_name" name global "pkgver" "%{pkg_name}-%{version}" - when (hasLib || subpackage) $ do + when (hasLibPkg || subpackage) $ do put "%{?haskell_setup}" putNewline - let pkgver = if hasLib then "%{pkgver}" else pkg_name ++ "-%{version}" + let pkgver = if hasLibPkg then "%{pkgver}" else pkg_name ++ "-%{version}" missingLibsLicenses <- do subs <- if subpackage then subPackages mspec pkgDesc else return [] @@ -296,7 +295,7 @@ let testable = notNull testsuiteDeps && not standalone && null missTestDeps && not notestsuite && isNothing mwithghc if testable then do - put "%bcond_without tests" + put "%bcond tests 1" putNewline else unless (null missTestDeps || standalone) $ do put $ "# testsuite missing deps: " ++ unwords (map display missTestDeps) @@ -319,7 +318,7 @@ return $ "CRLF" `isInfixOf` filetype else return False - putHdr "Name" (if binlib then "%{pkg_name}" else basename) + putHdr "Name" basename putHdr "Version" version if autorelease && not subpackage then putHdr "Release" "%autorelease" @@ -331,7 +330,7 @@ putHdr "Summary" summary putNewline putHdr "License" $ (prettyShow . license) pkgDesc - putHdr "Url" $ "https://hackage.haskell.org/package" pkg_name + putHdr "URL" $ "https://hackage.haskell.org/package" name put "# Begin cabal-rpm sources:" putHdr "Source0" $ sourceUrl pkgver when hasSubpkgs $ @@ -379,9 +378,9 @@ when (isJust mwithghc) $ put "%endif" let usesOptparse = hasExecPkg && any ((`elem` buildDeps pkgdeps) . mkPackageName) ["optparse-applicative","optparse-simple","simple-cmd-args"] - when usesOptparse $ + when (usesOptparse && null manpages) $ putHdr "BuildRequires" "help2man" - let common = binlib && datafiles /= [] && not standalone + let common = binlib && datafiles /= [] versionRelease = " = %{version}-%{release}" when common $ putHdr "Requires" $ "%{name}-common" ++ versionRelease @@ -512,7 +511,7 @@ put "# Begin cabal-rpm build:" if standalone then do global "cabal_install" "%{_bindir}/cabal" - put "%cabal_install update" + put $ "%cabal_install update" +-+ (if isJust mwithghc then "-w ghc-%{ghc_major}" else "") put "%if %{defined rhel} && 0%{?rhel} < 9" put "%cabal_install sandbox init" -- FIXME support mwithghc? @@ -547,8 +546,8 @@ putNewline warn verbose $ "doc files found in datadir:" +-+ unwords dupdocs put $ "rm %{buildroot}%{_datadir}" pkgver - case length dupdocs of - 1 -> head dupdocs + case dupdocs of + [hd] -> hd _ -> "{" ++ intercalate "," dupdocs ++ "}" when (hasLibPkg && not hasModules) $ @@ -557,14 +556,13 @@ when common $ put "mv %{buildroot}%{_ghcdocdir}{,-common}" - let execs = sort $ map exeName $ filter isBuildable $ executables pkgDesc + let execs = builtExecs pkgDesc execNaming p = let pn = unUnqualComponentName p in if pn == name then "%{name}" else pn -- FIXME check for included file maybeGenerateBashCompletion exn = put $ "%{buildroot}%{_bindir}" exn +-+ "--bash-completion-script" +-+ exn +-+ "| sed s/filenames/default/ >" +-+ "%{buildroot}%{bash_completions_dir}" exn - -- FIXME check for included file - maybeGenerateManpage exn = + generateManpage exn = put $ "help2man --no-info %{buildroot}%{_bindir}" exn +-+ ">" +-+ "%{buildroot}%{_mandir}/man1" exn <.> "1" when usesOptparse $ do @@ -573,10 +571,16 @@ put "mkdir -p %{buildroot}%{bash_completions_dir}" -- FIXME convert to for loop mapM_ (maybeGenerateBashCompletion . execNaming) execs + when (null manpages) $ do + putNewline + put "mkdir -p %{buildroot}%{_mandir}/man1/" + -- FIXME convert to for loop + mapM_ (generateManpage . execNaming) execs + unless (null manpages) $ do putNewline put "mkdir -p %{buildroot}%{_mandir}/man1/" - -- FIXME convert to for loop - mapM_ (maybeGenerateManpage . execNaming) execs + forM_ manpages $ \man -> + put $ "install -m 644 -p -t %{buildroot}%{_mandir}/man1/" +-+ man put "# End cabal-rpm install" sectionNewline @@ -606,7 +610,10 @@ put $ "%{_datadir}" pkgver when usesOptparse $ do mapM_ (put . ("%{bash_completions_dir}" ) . execNaming) execs - mapM_ (put . (\e -> "%{_mandir}/man1" e <.> "1*") . execNaming) execs + when (null manpages) $ + mapM_ (put . (\e -> "%{_mandir}/man1" e <.> "1*") . execNaming) execs + unless (null manpages) $ + mapM_ (put . (\m -> "%{_mandir}/man1" takeFileName m ++ "*")) manpages put "# End cabal-rpm files" sectionNewline @@ -638,8 +645,11 @@ mapM_ (\l -> put $ license_macro +-+ l) licensefiles unless (common || null docs) $ put $ "%doc" +-+ unwords docs - unless binlib $ + unless binlib $ do mapM_ ((\p -> put $ "%{_bindir}" (if p == name then "%{pkg_name}" else p)) . unUnqualComponentName) execs + unless (null manpages) $ + mapM_ (put . (\m -> "%{_mandir}/man1" takeFileName m ++ "*")) manpages + -- put "# End cabal-rpm files" sectionNewline @@ -672,9 +682,6 @@ createSpecFile_ ignoreMissing verbose flags notestsuite force pkgtype subpkgStream mwithghc mpvs = void (createSpecFile ignoreMissing verbose flags False notestsuite force pkgtype subpkgStream mwithghc Nothing mpvs) -isBuildable :: Executable -> Bool -isBuildable exe = buildable $ buildInfo exe - sourceUrl :: String -> String sourceUrl pv = "https://hackage.haskell.org/package" pv pv <.> ".tar.gz" @@ -704,18 +711,16 @@ number :: [a] -> [(String,a)] number = zip (map show [(1::Int)..]) -getPkgName :: Maybe FilePath -> String -> PackageDescription -> Bool +getPkgName :: Maybe FilePath -> String -> PackageDescription -> Bool -> Bool -> IO (String, Bool) -getPkgName (Just spec) _ pkgDesc binary = do +getPkgName (Just spec) _ pkgDesc binary hasLibPkg = do let name = display . pkgName $ package pkgDesc pkgname = takeBaseName spec - hasLib = hasLibs pkgDesc - return $ if name == pkgname || binary then (name, hasLib) else (pkgname, False) -getPkgName Nothing ghcname pkgDesc binary = do + return $ if name == pkgname || binary then (name, hasLibPkg) else (pkgname, False) +getPkgName Nothing ghcname pkgDesc binary hasLibPkg = do let name = display . pkgName $ package pkgDesc hasExec = hasExes pkgDesc - hasLib = hasLibs pkgDesc - return $ if binary || hasExec && not hasLib then (name, hasLib) else (ghcname ++ "-" ++ name, False) + return $ if binary || hasExec && not hasLibPkg then (name, hasLibPkg) else (ghcname ++ "-" ++ name, False) quoteMacros :: String -> String quoteMacros "" = "" @@ -729,3 +734,7 @@ ifJust :: Maybe a -> (a -> IO Bool) -> IO Bool ifJust Nothing _ = return False ifJust (Just x) act = act x + +htmlEntityDecode :: String -> String +htmlEntityDecode = + TL.unpack . TLB.toLazyText . HD.htmlEncodedText . T.pack diff --git a/src/Commands/Update.hs b/src/Commands/Update.hs --- a/src/Commands/Update.hs +++ b/src/Commands/Update.hs @@ -26,10 +26,6 @@ import Stackage (defaultLTS) import Types -import SimpleCabal (customFieldsPD, package, - PackageIdentifier (..), showVersion) -import SimpleCmd -import SimpleCmd.Git (grepGitConfig, rwGitDir) #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif @@ -38,6 +34,10 @@ import Data.Maybe import Distribution.Text (display) import Distribution.Verbosity (silent) +import SimpleCabal (customFieldsPD, package, + PackageIdentifier (..), showVersion) +import SimpleCmd (cmd, cmd_, error', grep_, shell_, (+-+)) +import SimpleCmd.Git (grepGitConfig, rwGitDir) import System.Directory (createDirectoryIfMissing, doesDirectoryExist, removeDirectoryRecursive, renameFile) import System.FilePath ((<.>)) @@ -59,7 +59,7 @@ Nothing -> do stream <- withSpecHead spec $ \ headerwords -> do - let mspecstream = read <$> headerOption "--stream" headerwords + let mspecstream = readStream <$> headerOption "--stream" headerwords case mspecstream of Just specStream -> do putStrLn $ "Using stream" +-+ showStream specStream +-+ "from spec file" diff --git a/src/Dependencies.hs b/src/Dependencies.hs --- a/src/Dependencies.hs +++ b/src/Dependencies.hs @@ -41,29 +41,13 @@ import SysCmd (rpmEval) import Types -import SimpleCabal (allLibraries, buildDependencies, mkPackageName, - exeDepName, Library(..), - PackageDescription (package), - PackageIdentifier(..), - PackageName, pkgcfgDepName, pkgName, - setupDependencies, testsuiteDependencies, -#if !MIN_VERSION_Cabal(2,2,0) - showVersion, -#endif -#if MIN_VERSION_Cabal(2,0,0) - unPackageName -#endif - ) -import SimpleCmd (cmd, cmdBool, removePrefix, removeSuffix, warning, (+-+)) -import SimpleCmd.Rpm (rpmspec) - #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif import Control.Monad (filterM, when, unless) import Data.List (delete, isSuffixOf, nub, (\\)) -import Data.Maybe (catMaybes, fromJust, isJust, isNothing, mapMaybe) +import Data.Maybe (catMaybes, fromJust, fromMaybe, isJust, isNothing, mapMaybe) #if !MIN_VERSION_Cabal(2,2,0) import Distribution.License (License (..)) @@ -78,13 +62,33 @@ #if MIN_VERSION_Cabal(2,0,0) import Distribution.Types.ExeDependency (ExeDependency(..)) #endif +import Safe (headMay) +import SimpleCabal (allLibraries, buildDependencies, mkPackageName, + exeDepName, Library(..), + PackageDescription (package), + PackageIdentifier(..), + PackageName, pkgcfgDepName, pkgName, + setupDependencies, testsuiteDependencies, +#if !MIN_VERSION_Cabal(2,2,0) + showVersion, +#endif +#if MIN_VERSION_Cabal(2,0,0) + unPackageName +#endif + ) +import SimpleCmd (cmd, cmdBool, removePrefix, removeSuffix, warning, (+-+)) +import SimpleCmd.Rpm (rpmspec) import System.Directory (doesDirectoryExist, doesFileExist) import System.FilePath ((<.>), ()) excludedPkgs :: PackageName -> Bool excludedPkgs = - flip notElem $ map mkPackageName ["ghc-prim", "integer-gmp", "system-cxx-std-lib"] + flip notElem $ map mkPackageName ["ghc-prim", "integer-gmp", "rts", "system-cxx-std-lib"] +excludedTools :: String -> Bool +excludedTools n = + n `notElem` ["ghc", "hsc2hs", "perl"] + pkgSuffix :: LibPkgType -> String pkgSuffix lpt = if null rep then "" else '-' : rep @@ -168,7 +172,6 @@ -> IO PackageDependencies packageDependencies pkgDesc = do let (deps, setup, tools', clibs', pkgcfgs) = dependencies pkgDesc - excludedTools n = n `notElem` ["ghc", "hsc2hs", "perl"] tools = filter excludedTools $ nub $ map mapTools tools' -- nothing provides libpthread.so clibsWithErrors <- mapM resolveLib $ delete "pthread" clibs' @@ -192,7 +195,7 @@ where tests = map testBuildInfo $ testSuites pkgDesc testTools = map exeDepName $ concatMap buildTools tests - testToolDeps = concatMap buildToolDepends' tests + testToolDeps = concatMap (filter excludedTools . buildToolDepends') tests missingPackages :: PackageDescription -> IO [RpmPackage] missingPackages pkgDesc = do @@ -256,8 +259,7 @@ else return res where singleLine :: String -> String - singleLine "" = "" - singleLine s = (head . lines) s + singleLine = fromMaybe "" . headMay . lines subPackages :: Maybe FilePath -> PackageDescription -> IO [PackageName] subPackages mspec pkgDesc = do diff --git a/src/FileUtils.hs b/src/FileUtils.hs --- a/src/FileUtils.hs +++ b/src/FileUtils.hs @@ -21,6 +21,9 @@ filesWithExtension, fileWithExtension, fileWithExtension_, +#if !MIN_VERSION_filepath(1,4,2) + isExtensionOf, +#endif listDirectory', mktempdir, withCurrentDirectory, diff --git a/src/Header.hs b/src/Header.hs --- a/src/Header.hs +++ b/src/Header.hs @@ -6,7 +6,8 @@ where import Data.List (isPrefixOf) -import SimpleCmd (removePrefix) +import Safe (headMay, tailSafe) +import SimpleCmd (removePrefix, (+-+)) import FileUtils (assertFileNonEmpty) @@ -16,7 +17,10 @@ readFile spec >>= (act . headerWords) where headerWords :: String -> [String] - headerWords = words . head . lines + headerWords s = + case headMay $ lines s of + Nothing -> error $ "empty" +-+ spec + Just h -> words h headerVersion :: [String] -> String headerVersion headerwords = @@ -26,7 +30,5 @@ _ -> "0.9.11" headerOption :: String -> [String] -> Maybe String -headerOption opt headerwords = - if opt `elem` headerwords - then (Just . head . tail . dropWhile (/= opt)) headerwords - else Nothing +headerOption opt = + headMay . tailSafe . dropWhile (/= opt) diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -33,6 +33,7 @@ -- allows building with 0.1.6 --import Options.Applicative (maybeReader) #endif +import Safe (headMay, tailSafe) import System.IO (BufferMode(LineBuffering), hSetBuffering, stdout) import Commands.BuildDep (builddep) @@ -64,7 +65,7 @@ <*> quietOpt <*> flags <*> notestsuite - <*> force + <*> pure False -- force <*> pkgtype <*> fmap toSubpkgStream subpackage <*> optional (readVersion <$> strOptionWith 'w' "with-ghc" "VERSION" "ghc compiler version") @@ -133,7 +134,7 @@ <*> pkgVerSpecifier , Subcommand "update" "Update package to latest version" $ update - <$> optional (optionWith auto 'o' "old-stream" "OLDSTREAM" "Current subpackage stream") + <$> optional (readStream <$> strOptionWith 'o' "old-stream" "OLDSTREAM" "Current subpackage stream") <*> pkgVerSpecifier ] where @@ -147,8 +148,8 @@ mapToFlags Nothing = [] mapToFlags (Just cs) = let ws = words cs in - case partition (\w -> head w == '-') ws of - (ds,es) -> map (\f -> (mkFlagName f,True)) es ++ map (\f -> (mkFlagName (tail f),False)) ds + case partition (\w -> headMay w == Just '-') ws of + (ds,es) -> map (\f -> (mkFlagName f,True)) es ++ map (\f -> (mkFlagName (tailSafe f),False)) ds quietRpmbuild = switchWith 'q' "quiet" "Quiet rpmbuild output" verboseRpmbuild = flagWith True False 'v' "verbose" "Verbose rpmbuild output" @@ -156,8 +157,8 @@ notestsuite :: Parser Bool notestsuite = switchWith 'T' "no-tests" "Disable test-suite (even if deps available)" - force :: Parser Bool - force = switchWith 'F' "force" "Force overwriting existing of any .spec file" + -- force :: Parser Bool + -- force = switchWith 'F' "force" "Force overwriting existing of any .spec file" dryrun = switchWith 'n' "dry-run" "Just show patch" @@ -176,7 +177,7 @@ pkgVerSpecifier :: Parser (Maybe PackageVersionSpecifier) pkgVerSpecifier = streamPkgToPVS - <$> optional (optionWith auto 's' "stream" "STREAM" "Stackage stream or Hackage") + <$> optional (readStream <$> strOptionWith 's' "stream" "STREAM" "Stackage stream or Hackage") <*> pkgId toSubpkgStream :: Bool -> Maybe (Maybe Stream) diff --git a/src/PackageUtils.hs b/src/PackageUtils.hs --- a/src/PackageUtils.hs +++ b/src/PackageUtils.hs @@ -35,55 +35,86 @@ rpmInstall, RpmStage (..), packageMacro, - readGlobalMacro + readGlobalMacro, + builtExecs ) where -import Data.Ord (comparing, Down(Down)) -import FileUtils (assertFileNonEmpty, filesWithExtension, fileWithExtension, - listDirectory', withTempDirectory) -import SimpleCabal (finalPackageDescription, licenseFiles, mkPackageName, - PackageDescription, PackageIdentifier(..), PackageName, - showPkgId, tryFindPackageDesc) -import SimpleCmd (cmd, cmd_, cmdBool, cmdIgnoreErr, cmdLines, - cmdStderrToStdoutIn, error', grep, grep_, - removePrefix, sudo, sudo_, (+-+)) -import SimpleCmd.Git (isGitDir, grepGitConfig) -import SimpleCmd.Rpm (rpmspec) -import SysCmd (optionalProgram, requireProgram, rpmEval) -import Stackage (defaultLTS, latestStackage) -import Types - #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif import Control.Monad (filterM, forM_, unless, void, when) - import Data.List.Extra import Data.Maybe +import Data.Ord (comparing, Down(Down)) import Data.Time.Clock (diffUTCTime, getCurrentTime) - +import Distribution.PackageDescription (buildable, Executable(buildInfo), + exeName, executables, + ) import Distribution.Text (display, simpleParse) +#if MIN_VERSION_Cabal(2,0,0) +import Distribution.Types.UnqualComponentName (UnqualComponentName(), + mkUnqualComponentName) +#endif #if MIN_VERSION_Cabal(3,6,0) import Distribution.Utils.Path (getSymbolicPath) #endif - -import System.Directory +import Safe (headMay, tailSafe) +import SimpleCabal (finalPackageDescription, licenseFiles, mkPackageName, + PackageDescription, PackageIdentifier(..), PackageName, + showPkgId, tryFindPackageDesc) +import SimpleCmd (cmd, cmd_, cmdBool, cmdIgnoreErr, cmdLines, + cmdStderrToStdoutIn, error', grep, grep_, + removePrefix, sudo, sudo_, (+-+)) +import SimpleCmd.Git (isGitDir, grepGitConfig) +import SimpleCmd.Rpm (rpmspec) +import System.Directory.Extra (copyFile, createDirectoryIfMissing, + doesDirectoryExist, doesFileExist, + getCurrentDirectory, getModificationTime, + listFilesRecursive, withCurrentDirectory) import System.Environment (getEnv) import System.FilePath import System.IO (hIsTerminalDevice, stdout) import System.Posix.Files (accessTime, fileMode, getFileStatus, modificationTime, setFileMode) -simplePackageDescription :: Flags -> FilePath - -> IO (PackageDescription, [FilePath], [FilePath]) -simplePackageDescription flags cabalfile = do +import FileUtils (assertFileNonEmpty, filesWithExtension, fileWithExtension, +#if !MIN_VERSION_filepath(1,4,2) + isExtensionOf, +#endif + listDirectory', withTempDirectory) +import SysCmd (optionalProgram, requireProgram, rpmEval) +import Stackage (defaultLTS, latestStackage) +import Types + + +simplePackageDescription :: Flags -> FilePath -> Maybe FilePath + -> IO PackageData +simplePackageDescription flags cabalfile mspec = do final <- finalPackageDescription flags cabalfile - (docs, licensefiles) <- findDocsLicenses (dropFileName cabalfile) final - return (final, docs, licensefiles) + (docs, licensefiles, manpages) <- findDocsLicenses (dropFileName cabalfile) final + return $ PackageData mspec final docs licensefiles manpages --- FIXME only include (doc) files listed in the .cabal file +builtExecs :: PackageDescription -> +#if MIN_VERSION_Cabal(2,0,0) + [UnqualComponentName] +#else + [String] +#endif +builtExecs = sort . map exeName . filter isBuildable . executables + where + isBuildable :: Executable -> Bool + isBuildable = buildable . buildInfo + +#if !MIN_VERSION_Cabal(2,0,0) +mkUnqualComponentName :: String -> String +mkUnqualComponentName = id +#endif + +-- FIXME only include (doc/man) files listed in the .cabal file -- eg ChangeLog.md may exist but not dist packaged -findDocsLicenses :: FilePath -> PackageDescription -> IO ([FilePath], [FilePath]) +-- (edge case for packaging from git repo) +findDocsLicenses :: FilePath -> PackageDescription + -> IO ([FilePath], [FilePath], [FilePath]) findDocsLicenses dir pkgDesc = do contents <- listDirectory' dir let docs = sort $ filter unlikely $ filter (likely docNames) contents @@ -91,14 +122,19 @@ (map getSymbolicPath (licenseFiles pkgDesc) ++ filter (likely licenseNames) contents) docfiles = if null licenses then docs else filter (`notElem` licenses) docs - return (docfiles, licenses) - where docNames = ["announce", "author", "bugs", "changelog", "changes", - "contribut", "example", "news", "readme", "todo"] - licenseNames = ["copying", "licence", "license"] - likely :: [String] -> String -> Bool - likely names name = any (`isPrefixOf` lower name) names - unlikely name = not $ any (`isSuffixOf` name) - ["~", ".cabal", ".hs", ".hi", ".o"] + let execs = builtExecs pkgDesc + manpages <- filter (\f -> ".1" `isExtensionOf` f && + mkUnqualComponentName (takeBaseName f) `elem` execs) <$> + withCurrentDirectory dir (listFilesRecursive ".") + return (docfiles, licenses, manpages) + where + docNames = ["announce", "author", "bugs", "changelog", "changes", + "contribut", "example", "news", "readme", "todo"] + licenseNames = ["copying", "licence", "license"] + likely :: [String] -> String -> Bool + likely names name = any (`isPrefixOf` lower name) names + unlikely name = not $ any (`isSuffixOf` name) + ["~", ".cabal", ".hs", ".hi", ".o"] bringTarball :: PackageIdentifier -> Maybe FilePath -> IO () bringTarball pkgid mspec = do @@ -154,19 +190,20 @@ paths = map (\ repo -> cacheparent repo tarpath) remotes -- if more than one tarball, should maybe warn if they are different tarballs <- filterM doesFileExist paths - if null tarballs - then if ranFetch - then error $ "no" +-+ tarfile +-+ "found" - else do - cabal_ "fetch" ["-v0", "--no-dependencies", display pkgid'] - copyTarball True dir file - else do - createDirectoryIfMissing True dir - copyFile (head tarballs) dest - -- cabal-1.18 fetch creates tarballs with mode 0600 - stat <- getFileStatus dest - when (fileMode stat /= 0o100644) $ - setFileMode dest 0o0644 + case tarballs of + [] -> + if ranFetch + then error $ "no" +-+ tarfile +-+ "found" + else do + cabal_ "fetch" ["-v0", "--no-dependencies", display pkgid'] + copyTarball True dir file + (tarball:_) -> do + createDirectoryIfMissing True dir + copyFile tarball dest + -- cabal-1.18 fetch creates tarballs with mode 0600 + stat <- getFileStatus dest + when (fileMode stat /= 0o100644) $ + setFileMode dest 0o0644 getSourceDir :: IO FilePath getSourceDir = do @@ -227,22 +264,25 @@ [ "--define="++ mcr +-+ cwd | gitDir, mcr <- ["_sourcedir"]] let args = ["-b" ++ singleton rpmCmd] ++ ["--nodeps" | mode == Prep] ++ rpmdirs_override ++ [spec] - if not quiet then - cmd_ "rpmbuild" args + if not quiet + then cmd_ "rpmbuild" args else do putStr $ "rpmbuild" +-+ show mode ++ ": " -- may hang for build (ok, out) <- cmdStderrToStdoutIn "rpmbuild" args "" if ok - then putStrLn "done" - else error' $ "\n" ++ dropToPrefix "+ /usr/bin/chmod -Rf" out + then putStrLn "done" + else error' $ "\n" ++ dropToPrefix "+ /usr/bin/chmod -Rf" out where dropToPrefix :: String -> String -> String dropToPrefix _ "" = "" dropToPrefix prefix cs = let ls = lines cs rest = dropWhile (not . (prefix `isPrefixOf`)) ls - in unlines (if null rest then tail ls else tail rest) + in unlines $ + case rest of + [] -> tailSafe ls + (_:rs) -> rs #if !MIN_VERSION_base(4,15,0) singleton :: Char -> String @@ -321,18 +361,18 @@ else do let field = " Default available version: " let avails = map (removePrefix field) $ filter (isPrefixOf field) top - if null avails - then error $ pkg +-+ "latest available version not found" - else do - let res = pkg ++ "-" ++ head avails - putStrLn $ res +-+ "in Hackage" - return $ PackageIdentifier (mkPackageName pkg) $ readVersion $ head avails + case avails of + [] -> error $ pkg +-+ "latest available version not found" + (avail:_) -> do + let res = pkg ++ "-" ++ avail + putStrLn $ res +-+ "in Hackage" + return $ PackageIdentifier (mkPackageName pkg) $ readVersion avail checkForSpecFile :: Maybe PackageName -> IO (Maybe FilePath) checkForSpecFile mpkg = do allSpecs <- filesWithExtension "." ".spec" -- emacs makes ".#*.spec" tmp files - let predicate = maybe ((/= '.') . head) ((\ pkg -> (`elem` [pkg <.> "spec", "ghc-" ++ pkg <.> "spec"])) . display) mpkg + let predicate = maybe ((/= Just '.') . headMay) ((\ pkg -> (`elem` [pkg <.> "spec", "ghc-" ++ pkg <.> "spec"])) . display) mpkg specs = filter predicate allSpecs when (specs /= allSpecs && isNothing mpkg) $ putStrLn "Warning: dir contains a hidden spec file" @@ -376,9 +416,7 @@ Nothing -> do mcabal <- checkForCabalFile mpkg case mcabal of - Just cabalfile -> do - (pkgDesc, docs, licenses) <- simplePackageDescription flags cabalfile - return $ PackageData Nothing docs licenses pkgDesc + Just cabalfile -> simplePackageDescription flags cabalfile Nothing Nothing -> case mpkg of Just pkg -> prepStreamPkg flags mnv Nothing defaultLTS pkg @@ -393,35 +431,39 @@ specPackageData spec = do assertFileNonEmpty spec cabalfile <- cabalFromSpec spec - (pkgDesc, docs, licenses) <- simplePackageDescription flags cabalfile - return $ PackageData (Just spec) docs licenses pkgDesc + simplePackageDescription flags cabalfile (Just spec) where cabalFromSpec :: FilePath -> IO FilePath cabalFromSpec specFile = do -- FIXME handle ghcX.Y havePkgname <- grep_ "%{pkg_name}" specFile -- FIXME handle bin packages starting with ghc, like "ghc-tags" - nv <- head - <$> rpmspec ["--srpm"] (Just "%{name}-%{version}") specFile - let namever = (if havePkgname then removePrefix "ghc-" else id) nv - case simpleParse namever of - Nothing -> error' $ "pkgid could not be parsed:" +-+ namever - Just pkgid -> do - bringTarball pkgid (Just specFile) - builddir <- getBuildDir $ Just nv - let pkgsrcdir = builddir namever - dExists <- doesDirectoryExist pkgsrcdir - if dExists - then do - specTime <- modificationTime <$> getFileStatus specFile - dirTime <- accessTime <$> getFileStatus pkgsrcdir - when (specTime > dirTime) $ do - rpmbuild True Prep specFile - dExists' <- doesDirectoryExist pkgsrcdir - when dExists' $ cmd_ "touch" [pkgsrcdir] - else - rpmbuild True Prep specFile - tryFindPackageDesc pkgsrcdir + -- FIXME what about mnv above?? + mnv' <- headMay <$> + rpmspec ["--srpm"] (Just "%{name}-%{version}") specFile + case mnv' of + Nothing -> error' $ "Failed to determine NVR for" +-+ specFile + Just nv -> do + let namever = + (if havePkgname then removePrefix "ghc-" else id) nv + case simpleParse namever of + Nothing -> error' $ "pkgid could not be parsed:" +-+ namever + Just pkgid -> do + bringTarball pkgid (Just specFile) + builddir <- getBuildDir $ Just nv + let pkgsrcdir = builddir namever + dExists <- doesDirectoryExist pkgsrcdir + if dExists + then do + specTime <- modificationTime <$> getFileStatus specFile + dirTime <- accessTime <$> getFileStatus pkgsrcdir + when (specTime > dirTime) $ do + rpmbuild True Prep specFile + dExists' <- doesDirectoryExist pkgsrcdir + when dExists' $ cmd_ "touch" [pkgsrcdir] + else + rpmbuild True Prep specFile + tryFindPackageDesc pkgsrcdir -- findSpecFile :: PackageDescription -> RpmFlags -> IO (FilePath, Bool) -- findSpecFile pkgDesc flags = do @@ -432,9 +474,10 @@ data PackageData = PackageData { specFilename :: Maybe FilePath + , packageDesc :: PackageDescription , docFilenames :: [FilePath] , licenseFilenames :: [FilePath] - , packageDesc :: PackageDescription + , manpageFiles :: [FilePath] } prepPkgId :: Flags -> Maybe String -> Maybe FilePath @@ -442,8 +485,7 @@ prepPkgId flags mnv mspec pkgid = do void $ getRevisedCabal pkgid cabalfile <- tryUnpack mnv pkgid - (pkgDesc, docs, licenses) <- simplePackageDescription flags cabalfile - return $ PackageData mspec docs licenses pkgDesc + simplePackageDescription flags cabalfile mspec prepStreamPkg :: Flags -> Maybe String -> Maybe FilePath -> Stream -> PackageName -> IO PackageData @@ -451,9 +493,7 @@ pkgid <- latestPackage (Just stream) pkg mcabal <- checkForPkgCabalFile mnv pkgid case mcabal of - Just cabalfile -> do - (pkgDesc, docs, licenses) <- simplePackageDescription flags cabalfile - return $ PackageData mspec docs licenses pkgDesc + Just cabalfile -> simplePackageDescription flags cabalfile mspec Nothing -> prepPkgId flags mnv mspec pkgid prepare :: Flags -> Maybe String @@ -469,9 +509,7 @@ mspec <- checkForSpecFile $ Just (pkgName pkgid) mcabal <- checkForPkgCabalFile mpkgid pkgid case mcabal of - Just cabalfile -> do - (pkgDesc, docs, licenses) <- simplePackageDescription flags cabalfile - return $ PackageData mspec docs licenses pkgDesc + Just cabalfile -> simplePackageDescription flags cabalfile mspec Nothing -> prepPkgId flags mpkgid mspec pkgid PVStreamPackage stream Nothing -> do mspec <- checkForSpecFile Nothing diff --git a/src/Types.hs b/src/Types.hs --- a/src/Types.hs +++ b/src/Types.hs @@ -24,8 +24,9 @@ readVersion, RpmPackage(..), showRpm, - showStream, Stream(..), + readStream, + showStream, streamPkgToPVS, unversionedPkgId, Verbose(..) @@ -50,7 +51,7 @@ import SimpleCabal (FlagName, {-- mkFlagName, --} PackageIdentifier(..), PackageName) -import SimpleCmd (error') +import SimpleCmd (error', (+-+)) data LibPkgType = Base | Devel | Prof | Doc | Static deriving Eq @@ -98,17 +99,21 @@ showStream (LTS ver) = "lts-" <> show ver showStream Hackage = "hackage" -instance Read Stream where - readsPrec _ "hackage" = [(Hackage,"")] - readsPrec _ "nightly" = [(LatestNightly,"")] - readsPrec _ "lts" = [(LatestLTS,"")] - readsPrec _ input | "nightly-" `isPrefixOf` input = - let (date,rest) = span (\ c -> isDigit c || c == '-') $ removePrefix "nightly-" input in - [(Nightly date,rest)] - readsPrec _ input | "lts-" `isPrefixOf` input = - let (ver,rest) = span isDigit $ removePrefix "lts-" input in - [(LTS (read ver),rest)] - readsPrec _ _ = [] +readStream :: String -> Stream +readStream "hackage" = Hackage +readStream "nightly" = LatestNightly +readStream "lts" = LatestLTS +readStream input | "nightly-" `isPrefixOf` input = + let (date,rest) = span (\ c -> isDigit c || c == '-') $ removePrefix "nightly-" input in + if null rest + then Nightly date + else error $ "invalid Stream:" +-+ input + | "lts-" `isPrefixOf` input = + let (ver,rest) = span isDigit $ removePrefix "lts-" input in + if null rest + then LTS (read ver) + else error $ "invalid Stream:" +-+ input + | otherwise = error $ "invalid Stream:" +-+ input removePrefix :: String -> String-> String removePrefix pref orig = fromMaybe orig (stripPrefix pref orig)