Merge pull request #89 from mattpolzin/prompt-to-push

Prompt to commit & push

harmony.ipkg

@@ -1,5 +1,5 @@
 package harmony
-version = 2.5.0
+version = 2.6.0
 authors = "Mathew Polzin"
 license = "MIT"
 -- brief =

package.json

@@ -1,6 +1,6 @@
 {
  "name": "@mattpolzin/harmony",
- "version": "2.5.0",
+ "version": "2.6.0",
  "publishConfig": {
  "access": "public"
  },

src/AppVersion.idr

@@ -4,7 +4,7 @@ module AppVersion
 
 export
 appVersion : String
-appVersion = "2.5.0"
+appVersion = "2.6.0"
 
 export
 printVersion : HasIO io => io ()

src/Config.idr

@@ -215,14 +215,14 @@ createConfig envGithubPAT terminalColors editor = do
  putStrLn "What GitHub remote repo would you like to use harmony for\{remoteDefaultStr}?"
  defaultRemote <- Just . orIfEmpty (Just remoteGuess) . trim <$> getLine
 
- putStr "Would you like harmony to comment when it assigns reviewers? [Y/n] "
- commentOnAssign <- yesUnlessNo . trim <$> getLine
+ commentOnAssign <-
+  yesNoPrompt "Would you like harmony to comment when it assigns reviewers?"
 
- putStr "Would you like harmony to assign teams when it assigns reviewers? [Y/n] "
- assignTeams <- yesUnlessNo . trim <$> getLine
+ assignTeams <-
+  yesNoPrompt "Would you like harmony to assign teams when it assigns reviewers?"
 
- putStr "Would you like harmony to assign individual users when it assigns reviewers? [Y/n] "
- assignUsers <- yesUnlessNo . trim <$> getLine
+ assignUsers <-
+  yesNoPrompt "Would you like harmony to assign individual users when it assigns reviewers?"
 
  _ <- liftIO $ octokit pat
  putStrLn "Creating config..."
@@ -263,12 +263,6 @@ createConfig envGithubPAT terminalColors editor = do
  orIfEmpty (Just y) "" = y
  orIfEmpty (Just _) x = x
 
- yesUnlessNo : String -> Bool
- yesUnlessNo answer with (toLower answer)
- _ | "n" = False
- _ | "no" = False
- _ | _ = True
-
  org : Maybe GitRemote -> Maybe String
  org = map (.org)
 

src/FFI/Git.idr

@@ -56,6 +56,16 @@ pushNewBranch : Git => (remoteName : String) -> (branch : String) -> Promise ()
 pushNewBranch @{G ptr} remoteName branch =
  ignore . promiseIO $ prim__pushNewBranch ptr remoteName branch
 
+%foreign git_ffi "push"
+prim__push : Ptr GitRef
+ -> (onSuccess : String -> PrimIO ())
+ -> (onFailure : String -> PrimIO ())
+ -> PrimIO ()
+
+export
+push : Git => Promise ()
+push @{G ptr} = ignore . promiseIO $ prim__push ptr
+
 %foreign git_ffi "list_remotes"
 prim__listRemotes : Ptr GitRef
  -> (onSuccess : String -> PrimIO ())
@@ -89,12 +99,64 @@ prim__remoteTrackingBranch : Ptr GitRef
 
 export
 remoteTrackingBranch : Git => Promise (Maybe String)
-remoteTrackingBranch @{G ptr} =
- do str <- promiseIO $ prim__remoteTrackingBranch ptr
- pure $
- case strM str of
- StrNil => Nothing
- (StrCons x xs) => Just str
+remoteTrackingBranch @{G ptr} = do
+ str <- promiseIO $ prim__remoteTrackingBranch ptr
+ pure $
+ case strM str of
+ StrNil => Nothing
+ (StrCons x xs) => Just str
+
+%foreign git_ffi "uncommitted_changes"
+prim__uncommittedChanges : Ptr GitRef
+ -> (onSuccess : String -> PrimIO ())
+ -> (onFailure : String -> PrimIO ())
+ -> PrimIO ()
+
+||| Get the Git output for filenames with uncommitted changes. If there
+||| are no files with uncommitted changes, returns @Nothing@.
+export
+uncommittedChanges : Git => Promise (Maybe String)
+uncommittedChanges @{G ptr} = do
+ str <- promiseIO $ prim__uncommittedChanges ptr
+ pure $
+ case strM str of
+ StrNil => Nothing
+ (StrCons x xs) => Just str
+
+%foreign git_ffi "staged_changes"
+prim__stagedChanges : Ptr GitRef
+ -> (onSuccess : String -> PrimIO ())
+ -> (onFailure : String -> PrimIO ())
+ -> PrimIO ()
+
+||| Get the Git output for filenames with staged changes. If there
+||| are no files with staged changes, returns @Nothing@.
+export
+stagedChanges : Git => Promise (Maybe String)
+stagedChanges @{G ptr} = do
+ str <- promiseIO $ prim__stagedChanges ptr
+ pure $
+ case strM str of
+ StrNil => Nothing
+ (StrCons x xs) => Just str
+
+%foreign git_ffi "unpushed_commits"
+prim__unpushedCommits : Ptr GitRef
+ -> (onSuccess : String -> PrimIO ())
+ -> (onFailure : String -> PrimIO ())
+ -> PrimIO ()
+
+||| Get the Git output for unpushed commits (multiple lines per
+||| commit including the ref, author, and commit message). If there
+||| are no unpushed commits, returns @Nothing@.
+export
+unpushedCommits : Git => Promise (Maybe String)
+unpushedCommits @{G ptr} = do
+ str <- promiseIO $ prim__unpushedCommits ptr
+ pure $
+ case strM str of
+ StrNil => Nothing
+ (StrCons x xs) => Just str
 
 %foreign git_ffi "user_email"
 prim__userEmail : Ptr GitRef

src/PullRequest.idr

@@ -274,11 +274,47 @@ identifyOrCreatePR @{config} {isDraft} branch = do
  ignore $ removeFile "pr_description.tmp.md"
  pure description
 
+ continueGivenUncommittedChanges : Promise Bool
+ continueGivenUncommittedChanges = do
+ case !uncommittedChanges of
+ Just files => do
+ putStrLn "The following files have uncommitted changes:"
+ putStrLn files
+ yesNoPrompt "Would you like to continue creating a Pull Request anyway?"
+ Nothing => pure True
+
+ continueGivenStagedChanges : Promise Bool
+ continueGivenStagedChanges = do
+ case !stagedChanges of
+ Just files => do
+ putStrLn "The following files have staged but uncommitted changes:"
+ putStrLn files
+ yesNoPrompt "Would you like to continue creating a Pull Request anyway?"
+ Nothing => pure True
+
  createPR : Promise PullRequest
  createPR = do
- when (!remoteTrackingBranch == Nothing) $
- do putStrLn "Creating a new remote branch..."
- pushNewBranch (fromMaybe "origin" config.defaultRemote) branch
+ -- create a remote tracking branch if needed
+ whenNothing !remoteTrackingBranch $ do
+ putStrLn "Creating a new remote branch..."
+ pushNewBranch (fromMaybe "origin" config.defaultRemote) branch
+
+ -- ask if we should continue despite uncommitted changes
+ True <- continueGivenUncommittedChanges
+ | False => reject "Not creating a PR (for now)..."
+ True <- continueGivenStagedChanges
+ | False => reject "Not creating a PR (for now)..."
+
+ -- ask if unpushed commits should be pushed
+ whenJust !unpushedCommits $ \unpushedString => do
+ putStrLn "The following commits have not been pushed:\n"
+ putStrLn unpushedString
+ putStrLn "\n"
+ pushUnpushedChanges <-
+ yesNoPrompt "Would you like to push these changes before creating a PR?"
+ when pushUnpushedChanges push
+
+ -- proceed to creating a PR
  putStrLn "Creating a new PR for the current branch (\{branch})."
  putStrLn "What branch are you merging into (ENTER for default: \{config.mainBranch})?"
  baseBranchInput <- trim <$> getLine

src/Util.idr

@@ -12,6 +12,13 @@ import Text.PrettyPrint.Prettyprinter.Render.Terminal
 
 %default total
 
+||| Run the given applicative when the input is @Nothing@.
+||| The dual of @whenJust@.
+export
+whenNothing : Applicative f => Maybe a -> f () -> f ()
+whenNothing Nothing x = x
+whenNothing (Just _) _ = pure ()
+
 ||| Render with or without color based on configuration
 export
 renderString : Config => Doc AnsiStyle -> String
@@ -39,6 +46,21 @@ getManyLines = getMoreLines []
  ("" :: rest, "") => pure (reverse rest)
  _ => getMoreLines (line :: acc) fuel
 
+||| Ask a question and receive a yes/no response with yes being the default.
+||| You probably want your question String to end with a question mark;
+||| @yesNoPrompt@ will append "[Y/n]" to the end of your question for you.
+export
+yesNoPrompt : HasIO io => (question : String) -> io Bool
+yesNoPrompt question = do
+ putStr "\{question} [Y/n] "
+ yesUnlessNo . trim <$> getLine
+ where
+ yesUnlessNo : String -> Bool
+ yesUnlessNo answer with (toLower answer)
+ _ | "n" = False
+ _ | "no" = False
+ _ | _ = True
+
 ||| Get an absolute path for the given directory or file assuming the
 ||| given path is relative to the root of the Git repository.
 export

support/js/git.js

@@ -7,12 +7,15 @@ const git_git = () =>
 const idris__git_unpromisify = (promise, onSuccess, onFailure) =>
  promise.then(r => onSuccess(r)(), e => onFailure(e)())
 
+// trim a result (second argument) and pass it to the given callback (first argument).
+const idris__git_trim = callback => value => callback(value.trim())
+
 // current branch
 // @Returns String
 const git_current_branch = (git, onSuccess, onFailure) =>
  idris__git_unpromisify(
  git.raw('branch', '--show-current'),
- r => onSuccess(r.trim()),
+ idris__git_trim(onSuccess),
  onFailure
  )
 
@@ -32,18 +35,25 @@ const git_push_new_branch = (git, remoteName, branch, onSuccess, onFailure) =>
  onFailure
  )
 
+const git_push = (git, onSuccess, onFailure) =>
+ idris__git_unpromisify(
+ git.raw('push'),
+ r => onSuccess(''),
+ onFailure
+ )
+
 // remote URI
 const git_remote_uri = (git, remoteName, onSuccess, onFailure) =>
  idris__git_unpromisify(
  git.raw('remote', 'get-url', remoteName),
- r => onSuccess(r.trim()),
+ idris__git_trim(onSuccess),
  onFailure
  )
 
 const git_list_remotes = (git, onSuccess, onFailure) =>
  idris__git_unpromisify(
  git.raw('remote'),
- r => onSuccess(r.trim()),
+ idris__git_trim(onSuccess),
  onFailure
  )
 
@@ -56,21 +66,42 @@ const git_remote_tracking_branch = (git, onSuccess, onFailure) =>
  .then(headRef => 
  git.raw('for-each-ref', '--format', '%(upstream:short)', `${headRef.trim()}`),
  onFailure),
- r => onSuccess(r.trim()),
+ idris__git_trim(onSuccess),
+ onFailure
+ )
+
+const git_uncommitted_changes = (git, onSuccess, onFailure) =>
+ idris__git_unpromisify(
+ git.raw('diff', '--name-only'),
+ idris__git_trim(onSuccess),
+ onFailure
+ )
+
+const git_staged_changes = (git, onSuccess, onFailure) =>
+ idris__git_unpromisify(
+ git.raw('diff', '--staged', '--name-only'),
+ idris__git_trim(onSuccess),
+ onFailure
+ )
+
+const git_unpushed_commits = (git, onSuccess, onFailure) =>
+ idris__git_unpromisify(
+ git.raw('log', '@{push}..'),
+ idris__git_trim(onSuccess),
  onFailure
  )
 
 const git_user_email = (git, onSuccess, onFailure) =>
  idris__git_unpromisify(
  git.raw('config', '--get', 'user.email'),
- r => onSuccess(r.trim()),
+ idris__git_trim(onSuccess),
  onFailure
  )
 
 const git_root_dir = (git, onSuccess, onFailure) =>
  idris__git_unpromisify(
  git.raw('rev-parse', '--show-toplevel'),
- r => onSuccess(r.trim()),
+ idris__git_trim(onSuccess),
  onFailure
  )