diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,16 @@ # Revision history for releaser -## 0.1.0.0 -- YYYY-mm-dd +## 0.2.0.0 -- 2019-09-16 + +* Write cabal versions using a regex + + Unfortunately, cabal api can't operate on Cabal AST, + so we just resort to good old perl methods. + +* If any of the primitives fail, wait to retry. + +* Avoid checking out git branch since it's confusing. + +## 0.1.0.0 -- 2019-09-09 * First version. Released on an unsuspecting world. diff --git a/releaser.cabal b/releaser.cabal --- a/releaser.cabal +++ b/releaser.cabal @@ -1,7 +1,7 @@ cabal-version: 2.4 name: releaser synopsis: Automation of Haskell package release process -version: 0.1.0.0 +version: 0.2.0.0 license: Apache-2.0 license-file: LICENSE maintainer: domen@dev.si @@ -19,12 +19,15 @@ Releaser.Primitives hs-source-dirs: src default-language: Haskell2010 + default-extensions: OverloadedStrings build-depends: - base -any, + base >=4.7 && <5, Cabal -any, - regex-pcre -any, + regex-tdfa -any, + regex-tdfa-text -any, process -any, - pretty-terminal -any + pretty-terminal -any, + text -any executable releaser main-is: Main.hs @@ -35,5 +38,5 @@ autogen-modules: Paths_releaser build-depends: - base >=4.7 && <5, + base -any, releaser -any diff --git a/releaser/Main.hs b/releaser/Main.hs --- a/releaser/Main.hs +++ b/releaser/Main.hs @@ -13,7 +13,6 @@ gitAssertEmptyStaging version <- cabalBumpVersion "." let release = "v" <> version - gitCheckout release changelogPrepare -- make release diff --git a/src/Releaser/Primitives.hs b/src/Releaser/Primitives.hs --- a/src/Releaser/Primitives.hs +++ b/src/Releaser/Primitives.hs @@ -26,9 +26,12 @@ import System.Console.Pretty (Color(..), color) import System.Environment (lookupEnv) import System.Exit (ExitCode(..), exitFailure) -import Text.Regex.PCRE +import Text.Regex.TDFA +import Text.Regex.TDFA.Text import Data.Functor (void) import Data.List (intercalate) +import qualified Data.Text as T +import qualified Data.Text.IO as T import Text.ParserCombinators.ReadP (ReadP, readP_to_S) import Data.Version (parseVersion) import Distribution.PackageDescription.Parsec @@ -36,7 +39,6 @@ import Distribution.Types.PackageId (pkgVersion, pkgName) import Distribution.Types.PackageDescription (package) import Distribution.Types.GenericPackageDescription (packageDescription) -import Distribution.PackageDescription.PrettyPrint (writeGenericPackageDescription) import Distribution.Types.Version (versionNumbers, mkVersion') import Distribution.Simple.Utils (tryFindPackageDesc) import Distribution.Types.PackageName (unPackageName) @@ -51,6 +53,10 @@ hFlush stdout getLine +promptRetry :: String -> IO () +promptRetry str = + void $ prompt $ str <> ". Retry? (press enter) " + abort :: String -> IO a abort str = do putStrLnErr $ color Red ">> " <> str @@ -79,28 +85,26 @@ -- | Given a folder, find a Cabal file and update the package version cabalWriteVersion :: FilePath -> String -> IO () cabalWriteVersion dir versionStr = do - cabalFile <- tryFindPackageDesc dir - genericPackageDescription <- readGenericPackageDescription silent cabalFile - -- TODO: handle the read failure nicely - version <- case parseMaybe parseVersion versionStr of - Nothing -> abort "parsing the cabal version failed" - Just ver -> return ver - let - pd = packageDescription genericPackageDescription - p = package $ packageDescription genericPackageDescription - gpd = genericPackageDescription { packageDescription = pd { package = p { pkgVersion = mkVersion' version } } } - writeGenericPackageDescription cabalFile gpd - logStep $ "Bumped " <> unPackageName (pkgName p) <> " to " <> versionStr - where - parseMaybe :: ReadP a -> String -> Maybe a - parseMaybe parser input = - case readP_to_S parser input of - [] -> Nothing - xs -> Just $ fst (last xs) + if validCabalVersion versionStr + then do + cabalFile <- tryFindPackageDesc dir + cabalinfo <- cabalRead dir + cabal <- T.readFile cabalFile + let versionPrev :: T.Text + versionPrev = cabal =~ ("version:[ \t]*" ++ version cabalinfo) + if versionPrev == "" + then abort $ "Failed to replace version in " <> cabalFile <> ", please open an issue at https://github.com/domenkozar/releaser/issues" + else do + T.writeFile cabalFile $ T.replace versionPrev ("version: " <> T.pack versionStr) cabal + logStep $ "Bumped " <> name cabalinfo <> " to " <> versionStr + else do + promptRetry "Cabal version does not match /^[0-9]+([.][0-9]+)*$/" + void $ cabalBumpVersion dir + validCabalVersion :: String -> Bool validCabalVersion version = - version =~ "^[0-9]+([.][0-9]+)*$" + version =~ ("^[0-9]+([.][0-9]+)*$" :: String) putStrLnErr :: String -> IO () putStrLnErr = hPutStrLn stderr @@ -109,13 +113,8 @@ cabalBumpVersion dir = do cabalinfo <- cabalRead dir version <- prompt $ "Bump cabal version from " <> version cabalinfo <> " to: " - if validCabalVersion version - then do - cabalWriteVersion dir version - return version - else do - putStrLnErr "Cabal version does not match /^[0-9]+([.][0-9]+)*$/. Try again." - cabalBumpVersion dir + cabalWriteVersion dir version + return version cabalSdist :: FilePath -> IO FilePath cabalSdist dir = do @@ -130,7 +129,8 @@ cabalUpload sdistTarball = do logStep "Running $ cabal upload" -- TODO: recommend that credentials are configured via ~/cabal/config - interactiveProcess (proc "cabal" ["upload", "--publish", sdistTarball]) (return ()) $ \_ -> do + interactiveProcess (proc "cabal" ["upload", "--publish", sdistTarball]) $ \_ -> do + promptRetry "cabal upload" cabalUpload sdistTarball gitGetTags :: IO [String] @@ -142,7 +142,9 @@ gitCheckout tag = do logStep $ "Running $ git checkout -b " <> tag -- TODO: check for existing branch - void $ readProcess "git" ["checkout", "-b", tag] mempty + interactiveProcess (proc "git" ["checkout", "-b", tag]) $ \i -> do + promptRetry "git checkout failed" + gitCheckout tag gitTag :: String -> IO () gitTag tag = do @@ -150,22 +152,28 @@ tags <- gitGetTags if elem tag tags then abort "git tag already exists, please delete it and start over" - else interactiveProcess (proc "git" ["tag", "--annotate", "--sign", tag]) (return ()) $ \i-> do + else interactiveProcess (proc "git" ["tag", "--annotate", "--sign", tag]) $ \i -> do + promptRetry "git tag failed" gitTag tag gitCommit :: String -> IO () gitCommit message = do logStep $ "Running $ git commit " - void $ readProcess "git" ["commit", "-a", "-m", message] mempty + interactiveProcess (proc "git" ["commit", "-a", "-m", message]) $ \i -> do + promptRetry "git commit failed" + gitCommit message + gitPush :: String -> IO () gitPush remote = do logStep $ "Pushing git to " <> remote - void $ readProcess "git" ["push", remote, "HEAD"] mempty + interactiveProcess (proc "git" ["push", remote, "HEAD"]) $ \i -> do + promptRetry "git push" + gitPush remote gitPushTags :: String -> IO () gitPushTags remote = do - logStep $ "Pushing git to " <> remote + logStep $ "Pushing git tags to " <> remote void $ readProcess "git" ["push", remote, "--tags"] mempty gitAssertEmptyStaging :: IO () @@ -184,16 +192,16 @@ Nothing -> abort "please make sure $EDITOR is set" Just editor -> do -- TODO: prepare the changelog - interactiveProcess (proc editor ["CHANGELOG.md"]) (return ()) $ \i -> do + interactiveProcess (proc editor ["CHANGELOG.md"]) $ \i -> do logStep $ editor <> " failed with " <> show i <> ", retrying" changelogPrepare -- internal -interactiveProcess :: CreateProcess -> IO b -> (Int -> IO b) -> IO b -interactiveProcess cmd good bad = do +interactiveProcess :: CreateProcess -> (Int -> IO ()) -> IO () +interactiveProcess cmd bad = do (_, _, _, ph) <- createProcess cmd exitcode <- waitForProcess ph case exitcode of - ExitSuccess -> good + ExitSuccess -> return () ExitFailure i -> bad i