releaser 0.1.0.0 → 0.2.0.0
raw patch · 4 files changed
+66/−45 lines, 4 filesdep +regex-tdfadep +regex-tdfa-textdep +textdep −regex-pcredep ~basePVP ok
version bump matches the API change (PVP)
Dependencies added: regex-tdfa, regex-tdfa-text, text
Dependencies removed: regex-pcre
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- CHANGELOG.md +12/−1
- releaser.cabal +8/−5
- releaser/Main.hs +0/−1
- src/Releaser/Primitives.hs +46/−38
CHANGELOG.md view
@@ -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.
releaser.cabal view
@@ -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
releaser/Main.hs view
@@ -13,7 +13,6 @@ gitAssertEmptyStaging version <- cabalBumpVersion "." let release = "v" <> version- gitCheckout release changelogPrepare -- make release
src/Releaser/Primitives.hs view
@@ -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