wasp/waspc/new-release

#!/usr/bin/env cabal
{- cabal:
  build-depends:
    base == 4.*
    , turtle == 1.5.*
    , regex-tdfa == 1.3.*
    , text == 1.2.*
-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Arrow (second)
import Control.Monad (unless, when)
import qualified Data.Text as T
import qualified Data.Text.IO as T.IO
import System.Environment (getArgs)
import System.Exit (ExitCode (..), die)
import qualified Text.Regex.TDFA as TR
import Turtle (empty, shell, shellStrict)

main = do
  args <- getArgs
  case args of
    [version] -> makeNewRelease version
    _ -> putStrLn "Usage: new-release <version>"

makeNewRelease :: String -> IO ()
makeNewRelease newVersion = do
  (ExitSuccess, branchName) <- second T.strip <$> shellStrict "git rev-parse --abbrev-ref HEAD" empty
  case branchName of
    "release" -> return ()
    _ -> do
      putStrLn ""
      putStrLn $ "Are you sure you want to publish new release directly from the '" ++ T.unpack branchName ++ "' branch?"
      putStrLn "Such release will likely be out of sync with published documentation, examples and similar."
      putStrLn "Don't do this if you want to publish latest release, instead do it from the 'release' branch."
      putStrLn "If you instead want to publish a release candidate, or re-publish old release, or smth like that, then please continue by typing the current branch and release version as a confirmation that you know what you are doing."
      putStrLn "Branch you are on right now: "
      branchName' <- getLine
      putStrLn "Repeat the release version: "
      newVersion' <- getLine
      when (newVersion' /= newVersion) $ error "You typed incorrect release version."
      when (branchName' /= T.unpack branchName) $ error "You typed incorrect branch name."

  let cabalFileName = "waspc.cabal"
  versionFromCabalFile <- getVersionFromCabalFile . T.unpack <$> T.IO.readFile cabalFileName
  when (versionFromCabalFile /= newVersion) $ do
    putStrLn "\n"
    putStrLn $ "Version from " ++ cabalFileName ++ " file (" ++ versionFromCabalFile ++ ") does not match the release version (" ++ newVersion ++ ")."
    putStrLn "If you are doing a regular release, you will want these to match, so abort this script and go update the version in cabal file first."
    putStrLn "Or maybe you know what you are doing and want to continue? [Y/N]:"
    confirmation <- getLine
    when (confirmation /= "Y") $ die "Aborting"

  unlessM isWorkingTreeClean $ do
    putStrLn "\n"
    putStrLn "Your working tree is not clean! Run 'git status' to check it out."
    putStrLn "Only commited changes will become part of the release, so make sure you commited everything you wanted."
    putStrLn "Do you want to continue regardless? [Y/N]:"
    confirmation <- getLine
    when (confirmation /= "Y") $ die "Aborting"

  let tag = "v" ++ newVersion

  putStrLn $
    unlines
      [ "",
        "This will release wasp version " ++ versionFromCabalFile ++ ".",
        "tag " ++ tag ++ " will be created and pushed, triggering CI to create new release on Github.",
        "Are you sure you want to proceed? [Y/N]:"
      ]
  confirmation <- getLine
  when (confirmation /= "Y") $ die "Aborting"

  putStrLn $ "\nCreating tag " ++ tag ++ " and pushing it.\n"
  ExitSuccess <- shell (T.pack $ "git tag " ++ tag) empty
  ExitSuccess <- shell (T.pack $ "git push origin " ++ tag) empty

  putStrLn $ "Success! Check out Actions on Github to see how your new release is being built. Once it is built, draft release on Github will be created, with binaries attached. Then it is up to you to manually publish it from draft to proper release."
  return ()

getVersionFromCabalFile :: String -> String -- Returns version currently written in the cabal file.
getVersionFromCabalFile cabalFileContents = do
  let (beforeMatch, match, afterMatch, submatches) =
        cabalFileContents TR.=~ ("^(version: *)(.+)$" :: String) :: (String, String, String, [String])
      match' = trim match
   in if (null match')
        then error "Couldn't locate version in cabal file!?"
        else submatches !! 1

isWorkingTreeClean :: IO Bool
isWorkingTreeClean = do
  (exitCode, _) <- shellStrict "git status | grep 'nothing to commit, working tree clean'" empty
  return $ exitCode == ExitSuccess

unlessM ma perform = ma >>= (`unless` perform)

trim :: String -> String
trim = T.unpack . T.strip . T.pack