{-# LANGUAGE ViewPatterns #-}
module Cuk.Git
( runHop
, runFresh
, runNew
, runPush
, runResolve
, runCommit
, runFix
, runSync
, runCurrent
) where
import Data.Char (isAlphaNum, isDigit, isSpace)
import Cuk.ColorTerminal (arrow, errorMessage, greenCode, resetCode)
import Cuk.Issue (getIssueTitle, mkIssueId)
import Cuk.Shell (($|))
import qualified Data.Text as T
runHop :: Maybe Text -> IO ()
runHop (nameOrMaster -> branch) = do
"git" ["checkout", branch]
"git" ["pull", "--rebase", "--prune"]
runFresh :: Maybe Text -> IO ()
runFresh (nameOrMaster -> branch) = do
"git" ["fetch", "origin", branch]
"git" ["rebase", "origin/" <> branch]
runNew :: Int -> IO ()
runNew issueNum = do
login <- "git" $| ["config", "user.login"]
if login == ""
then errorMessage "user.login is not specified"
else do
let issueId = mkIssueId issueNum
issueTitle <- getIssueTitle issueId
let shortDesc = mkShortDesc issueTitle
let branchName = login <> "/" <> show issueNum <> "-" <> shortDesc
"git" ["checkout", "-b", branchName]
where
mkShortDesc :: Text -> Text
mkShortDesc =
T.intercalate "-"
. take 5
. words
. T.filter (\c -> isAlphaNum c || isDigit c || isSpace c)
runCommit :: Text -> Bool -> IO ()
runCommit (T.strip -> msg) (not -> hasIssue)
| msg == "" = errorMessage "Commit message cannot be empty"
| otherwise = do
branch <- getCurrentBranch
let issueNum = issueFromBranch branch
"git" ["add", "."]
"git" ["commit", "-m", showMsg $ guard hasIssue *> issueNum]
where
showMsg :: Maybe Int -> Text
showMsg = \case
Nothing -> msg
Just n ->
let issue = "#" <> show n
in "[" <> issue <> "] " <> msg <> "\n\nResolves " <> issue
runFix :: IO ()
runFix = do
"git" ["add", "."]
"git" ["commit", "--amend", "--no-edit"]
runPush True
runPush :: Bool -> IO ()
runPush isForce = getCurrentBranch >>= \branch ->
"git" $ ["push", "--set-upstream", "origin", branch]
++ ["--force" | isForce]
runSync :: IO ()
runSync = getCurrentBranch >>= \branch -> "git" ["pull", "--rebase", "origin", branch]
runResolve :: Maybe Text -> IO ()
runResolve (nameOrMaster -> master)= do
curBranch <- getCurrentBranch
runHop $ Just master
when (curBranch /= master) $ "git" ["branch", "-D", curBranch]
runCurrent :: IO (Maybe Int)
runCurrent = do
branchName <- getCurrentBranch
putTextLn $ arrow <> "Current branch: " <> greenCode <> branchName <> resetCode
pure $ issueFromBranch branchName
nameOrMaster :: Maybe Text -> Text
nameOrMaster = fromMaybe "master"
getCurrentBranch :: IO Text
getCurrentBranch = "git" $| ["rev-parse", "--abbrev-ref", "HEAD"]
issueFromBranch :: Text -> Maybe Int
issueFromBranch =
readMaybe
. toString
. T.takeWhile isDigit
. T.drop 1
. T.dropWhile (/= '/')