[#153] Create PRs with a new command/option (#180)

* [#153] Create PRs with a new command/option

Resolves #153

* [#153] Create PRs with a new command/option

Resolves #153

* Use owner, not the repo to check PRs head 🤦

* Fix

README.md

@@ -34,6 +34,7 @@ Or how you can see pretty short stats about your changes:
 To start using `hit` make sure that you have the following tools installed on your machine:
 
 + [ `git`][git] — `hit` is a wrapper around `git`
+* [`hub`](https://github.com/github/hub) – to make PRs to GitHub directly.
 + **Optional:** `diff-highlight` — for pretty output of the `hit diff` command
   + Linux installation instructions
     ```shell

hit-on.cabal

@@ -77,6 +77,7 @@ library
                            Hit.Git.Log
                            Hit.Git.Milestones
                            Hit.Git.New
+                           Hit.Git.Pr
                            Hit.Git.Push
                            Hit.Git.Resolve
                            Hit.Git.Stash
@@ -86,6 +87,7 @@ library
                            Hit.Git.Unstash
                            Hit.Git.Wip
                          Hit.GitHub
+                         Hit.Hub
                          Hit.Prompt
                          Hit.Issue
 

src/Hit/Cli.hs

@@ -26,8 +26,8 @@ import Options.Applicative (CommandFields, Mod, Parser, ParserInfo, argument, au
 import Hit.Core (CommitOptions (..), ForceFlag (..), IssueOptions (..), Milestone (..),
                  defaultIssueOptions)
 import Hit.Git (runAmend, runClear, runClone, runCommit, runCurrent, runDiff, runFix, runFresh,
-                runHop, runLog, runMilestones, runNew, runPush, runResolve, runStash, runStatus,
-                runSync, runUncommit, runUnstash, runWip)
+                runHop, runLog, runMilestones, runNew, runPr, runPush, runResolve, runStash,
+                runStatus, runSync, runUncommit, runUnstash, runWip)
 import Hit.Issue (runIssue)
 import Hit.Prompt (arrow)
 
@@ -58,6 +58,7 @@ hit = execParser cliParser >>= \case
     Clone name -> runClone name
     Log commit -> runLog commit
     Milestones -> runMilestones
+    Pr isDraft -> runPr isDraft
 
 ----------------------------------------------------------------------------
 -- Parsers
@@ -96,6 +97,8 @@ data HitCommand
     | Clone Text
     | Log (Maybe Text)
     | Milestones
+    | Pr
+        !Bool  -- ^ Create a draft PR?
 
 -- | Commands parser.
 hitP :: Parser HitCommand
@@ -107,6 +110,7 @@ hitP = subparser
    <> com "unstash"  unstashP  "Unstash previously stashed changes"
    <> com "commit"   commitP   "Commit all local changes and prepend issue number"
    <> com "wip"      wipP      "Create WIP commit"
+   <> com "pr"       prP       "Commit all local changes and open the PR at GitHub"
    <> com "uncommit" uncommitP "Reset to the previous commit saving the changes"
    <> com "fix"      fixP      "Fix requested changes to the last commit"
    <> com "amend"    amendP    "Amend changes to the last commit and force push"
@@ -217,6 +221,9 @@ logP = Log <$> maybeCommitP
 wipP :: Parser HitCommand
 wipP = pure Wip
 
+prP :: Parser HitCommand
+prP = Pr <$> switch (long "draft" <> short 'd' <> help "Create a draft PR")
+
 milestonesP :: Parser HitCommand
 milestonesP = pure Milestones
 

src/Hit/Git.hs

@@ -19,6 +19,7 @@ module Hit.Git
     , runUnstash
     , runCommit
     , runWip
+    , runPr
     , runUncommit
     , runFix
     , runAmend
@@ -47,6 +48,7 @@ import Hit.Git.Hop (runHop)
 import Hit.Git.Log (runLog)
 import Hit.Git.Milestones (runMilestones)
 import Hit.Git.New (runNew)
+import Hit.Git.Pr (runPr)
 import Hit.Git.Push (runPush)
 import Hit.Git.Resolve (runResolve)
 import Hit.Git.Stash (runStash)

src/Hit/Git/Commit.hs

@@ -29,7 +29,7 @@ import qualified Data.Text as T
 runCommit :: CommitOptions -> IO ()
 runCommit CommitOptions{..} = case coName of
     Just (T.strip -> msg)
-        | msg == "" -> errorMessage "Commit message cannot be empty"
+        | msg == "" -> errorMessage "Commit message cannot be empty" >> exitFailure
         | otherwise -> getCurrentIssue >>= commitCmds msg
     {- if the commit name is not specified then check the branchName
     If this is issue-related branch, take the issue name as the commit name.
@@ -38,7 +38,9 @@ runCommit CommitOptions{..} = case coName of
     Nothing -> do
         issueNum <- getCurrentIssue
         case issueNum of
-            Nothing -> errorMessage "Commit message cannot be empty: can not be taken from the context"
+            Nothing -> do
+                errorMessage "Commit message cannot be empty: can not be taken from the context"
+                exitFailure
             Just n -> do
                 title <- getIssueTitle (mkIssueId n)
                 commitCmds title issueNum

src/Hit/Git/Pr.hs

@@ -0,0 +1,63 @@
+{- |
+Module                  : Hit.Git.Pr
+Copyright               : (c) 2020 Kowainik
+SPDX-License-Identifier : MPL-2.0
+Maintainer              : Kowainik <xrom.xkov@gmail.com>
+Stability               : Stable
+Portability             : Portable
+
+@hit pr@ command runner and helpers.
+-}
+
+module Hit.Git.Pr
+    ( runPr
+    ) where
+
+import Colourista (errorMessage)
+import GitHub (untagName)
+import GitHub.Data.Options (optionsHead)
+import GitHub.Data.Request (FetchCount (..))
+import GitHub.Endpoints.PullRequests (pullRequestsForR)
+import GitHub.Request (executeRequest)
+
+import Hit.Core (CommitOptions (..), ForceFlag (..))
+import Hit.Git.Commit (runCommit)
+import Hit.Git.Common (getCurrentBranch, getUsername)
+import Hit.Git.New (runNew)
+import Hit.GitHub (withAuthOwnerRepo)
+import Hit.Hub (withHub)
+
+import qualified Data.Vector as V
+
+
+{- | @hit pr@ command.
+
+Creates a commit and a PR if the PR for corresponding branch doesn't exist already.
+It requires @hub@ tool to be installed.
+-}
+runPr :: Bool -> IO ()
+runPr isDraft = do
+    whenM ((== "master") <$> getCurrentBranch) $ runNew False "patch"
+    curBranch <- getCurrentBranch
+    -- check if the open PR with head @owner:branch_name@ already exist
+    res <- withAuthOwnerRepo $ \auth owner repo -> do
+        let headPrMod = optionsHead $ untagName owner <> ":" <> curBranch
+        executeRequest auth (pullRequestsForR owner repo headPrMod FetchAll)
+    case res of
+        Left err -> do
+            errorMessage "Can not get information about current PRs"
+            putTextLn $ "    " <> show err
+            exitFailure
+        Right prs ->
+            if (not $ V.null prs)
+            then errorMessage "PR for the current branch already exists" >> exitFailure
+            else do
+                runCommit CommitOptions
+                    { coName          = Nothing
+                    , coNoIssueNumber = False
+                    , coPush          = True
+                    , coIsForcePush   = Simple
+                    }
+                user <- getUsername
+                withHub $ ["pull-request", "--no-edit", "--assign", user, "--browse"]
+                    <> ["--draft" | isDraft]

src/Hit/Hub.hs

@@ -0,0 +1,38 @@
+{- |
+Module                  : Hit.Hub
+Copyright               : (c) 2020 Kowainik
+SPDX-License-Identifier : MPL-2.0
+Maintainer              : Kowainik <xrom.xkov@gmail.com>
+Stability               : Stable
+Portability             : Portable
+
+This module contains helper functions to work with @hub@ tool.
+-}
+
+module Hit.Hub
+    ( withHub
+    ) where
+
+import Colourista (errorMessage, warningMessage)
+import Shellmet (($?))
+import System.Directory (findExecutable)
+
+
+{- | Helper function to run the @hub@ tool
+
+It exits with error when the tool is not in PATH or the work of the tool was not
+successful.
+-}
+withHub
+    :: [Text]  -- ^ Hub command arguments
+    -> IO ()
+withHub hubArgs = findExecutable "hub" >>= \case
+    Just _ -> do
+        isHubSuccess <- (True <$ "hub" hubArgs) $? pure False
+        unless isHubSuccess $ do
+            warningMessage "Error running 'hub'. Possible reason: incorrect password."
+            exitFailure
+    Nothing -> do
+        errorMessage "'hub' is not found at this machine."
+        warningMessage "Please install 'hub' for the proper work of 'hit'."
+        exitFailure