kowainik/hit-on
1
1
Fork 0
mirror of https://github.com/kowainik/hit-on.git synced 2024-10-03 23:29:07 +03:00
Code Issues Projects Releases Wiki Activity

[#127] Assign users on hit new --issue command (#128)

Browse Source 
* [#127] Assign users on `hit new --issue` command

* Fix stack

* Update src/Hit/Git.hs

Co-Authored-By: Veronika Romashkina <vrom911@gmail.com>

* Improve description
This commit is contained in:
Dmitrii Kovanikov 2019-12-08 12:13:01 +00:00 committed by Veronika Romashkina
parent a924bcf2ae
commit 0680c67d7c
9 changed files with 171 additions and 100 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
CHANGELOG.md
View File

@ -3,9 +3,17 @@
`hit-on` uses [PVP Versioning][1].
The changelog is available [on GitHub][2].
### Unreleased
### Unreleased: 0.2.0.0
* Move to the newer `relude-0.6.0.0`.
* [#65](https://github.com/kowainik/hit-on/issues/55):
Add `--issue` option to `hit new` command to create issue.
(by [@bangn](https://github.com/bangn)).
* [#127](https://github.com/kowainik/hit-on/issues/127):
Assign user to issue on `hit new --issue` command.
(by [@chshersh](https://github.com/chshersh)).
* [#125](https://github.com/kowainik/hit-on/pull/125):
Move to the newer `relude-0.6.0.0`.
(by [@vrom911](https://github.com/vrom911)).
### 0.1.0.0 — Aug 3, 2019

4
app/Main.hs
View File

@ -1,9 +1,9 @@
module Main (main) where
import System.IO (hSetEncoding, stdout, utf8)
import System.IO (hSetEncoding, utf8)
import Hit (hit)
main :: IO ()
main = hSetEncoding stdout utf8 >> hit

30
hit-on.cabal
View File

@ -1,6 +1,6 @@
cabal-version: 2.4
name: hit-on
version: 0.1.0.0
version: 0.2.0.0
synopsis: Haskell Git Helper Tool
description: Haskell Git Helper Tool
homepage: https://github.com/kowainik/hit-on
@ -13,7 +13,7 @@ copyright: 2019 Kowainik
category: Git, CLI Tool
build-type: Simple
extra-doc-files: README.md
, CHANGELOG.md
CHANGELOG.md
tested-with: GHC == 8.6.5
source-repository head
@ -21,6 +21,12 @@ source-repository head
location: https://github.com/kowainik/hit-on.git
common common-options
build-depends: base ^>= 4.12.0.0
, relude ^>= 0.6.0.0
mixins: base hiding (Prelude)
, relude (Relude as Prelude)
ghc-options: -Wall
-Wincomplete-uni-patterns
-Wincomplete-record-updates
@ -60,17 +66,14 @@ library
autogen-modules: Paths_hit_on
other-modules: Paths_hit_on
Prelude
build-depends: base-noprelude ^>= 4.12.0.0
, ansi-terminal >= 0.8
build-depends: ansi-terminal >= 0.8
, directory ^>= 1.3
, github ^>= 0.23
, gitrev ^>= 1.3
, optparse-applicative ^>= 0.14
, optparse-applicative ^>= 0.15
, process ^>= 1.6
, relude ^>= 0.6.0.0
, shellmet >= 0.0.1
, shellmet ^>= 0.0.3.0
, text
, vector ^>= 0.12
@ -78,24 +81,19 @@ executable hit
import: common-options
hs-source-dirs: app
main-is: Main.hs
build-depends: hit-on
build-depends: base ^>= 4.12.0.0
, hit-on
ghc-options: -Wall
-threaded
ghc-options: -threaded
-rtsopts
-with-rtsopts=-N
test-suite hit-on-test
import: common-options
type: exitcode-stdio-1.0
hs-source-dirs: test
main-is: Main.hs
build-depends: base
, text
build-depends: text
, hspec
, github
, hit-on

10
src/Hit/Cli.hs
View File

@ -60,7 +60,9 @@ cliParser = info ( helper <*> versionP <*> hitP )
data HitCommand
= Hop (Maybe Text)
| Fresh (Maybe Text)
| New Bool Text
| New
Bool -- ^ Should create issue as well?
Text -- ^ Issue or branch name
| Issue (Maybe Int) Bool
| Stash
| Unstash
@ -114,9 +116,9 @@ freshP = Fresh <$> maybeBranchP
newP :: Parser HitCommand
newP = do
createIssue <- switch
$ long "issue"
<> short 'i'
<> help "Create new issue instead of branch"
$ long "issue"
<> short 'i'
<> help "Create new issue in addition to branch and assign it to you"
issueNumOrBranch <- strArgument (metavar "ISSUE_NUMBER_OR_BRANCH_NAME")
pure $ New createIssue issueNumOrBranch

2
src/Hit/ColorTerminal.hs
View File

@ -111,7 +111,7 @@ mkColor color = toText $ setSGRCode [SetColor Foreground Vivid color]
-- | Arrow symbol
arrow :: Text
arrow = " ➤ "
arrow = " ➤ "
-- | Represents a user's answer
data Answer = Y | N

88
src/Hit/Git.hs
View File

@ -26,15 +26,16 @@ module Hit.Git
import Control.Exception (bracket)
import Data.Char (isAlphaNum, isDigit, isSpace)
import GitHub (Issue (issueNumber), IssueNumber (..), unIssueNumber)
import Shellmet (($|))
import System.Directory (findExecutable)
import System.Process (callCommand)
import Hit.ColorTerminal (Answer (..), arrow, blueCode, errorMessage, greenCode, infoMessage,
prompt, resetCode, yesOrNoText)
import Hit.ColorTerminal (Answer (..), arrow, errorMessage, greenCode, infoMessage, prompt,
resetCode, successMessage, yesOrNoText)
import Hit.Core (CommitOptions (..), PushBool (..))
import Hit.Git.Status (showPrettyDiff)
import Hit.Issue (createIssue', getIssueTitle, issueNumber, mkIssueId, showIssueName, unIssueNumber)
import Hit.Issue (createIssue, getIssueTitle, mkIssueId)
import qualified Data.Text as T
@ -51,18 +52,45 @@ runFresh (nameOrMaster -> branch) = do
"git" ["fetch", "origin", branch]
"git" ["rebase", "origin/" <> branch]
-- | @hit new@ command.
runNew :: Bool -> Text -> IO ()
runNew False issueOrName = do
login <- getUsername
title <- case readMaybe @Int $ toString issueOrName of
Just issueNum -> do
issueTitle <- getIssueTitle $ mkIssueId issueNum
pure $ show issueNum <> "-" <> mkShortDesc issueTitle
Nothing -> pure $ mkShortDesc issueOrName
let branchName = login <> "/" <> title
"git" ["checkout", "-b", branchName]
-- QUESTION: should we somehow move this into separate module or split this module
-- smaller parts?
{- | This data type represents all cases on how to create short branch
name description. During 'hit new' command there can be several cases:
1. 'FromNewIssue': when new issue is created, we know its title and number.
2. 'FromIssueNumber': if issue is not created, we need to fetch its title by id.
3. 'FromText': if not issue number is provided, we just create raw text.
-}
data BranchDescription
= FromNewIssue Int Text
| FromIssueNumber Int
| FromText Text
-- | Create 'BranchTitle' from possible issue and issue number or text.
mkBranchDescription :: Maybe IssueNumber -> Text -> BranchDescription
mkBranchDescription (Just issueNum) title = FromNewIssue (unIssueNumber issueNum) title
mkBranchDescription Nothing issueOrName = case readMaybe @Int $ toString issueOrName of
Just issueNum -> FromIssueNumber issueNum
Nothing -> FromText issueOrName
{- | Display 'BranchDescription' in format:
@
123-short-issue-title
@
-}
displayBranchDescription :: BranchDescription -> IO Text
displayBranchDescription = \case
FromText text -> pure $ mkShortDesc text
FromNewIssue issueNum issueTitle -> pure $ nameWithNumber issueNum issueTitle
FromIssueNumber issueNum -> do
issueTitle <- getIssueTitle $ mkIssueId issueNum
pure $ nameWithNumber issueNum issueTitle
where
nameWithNumber :: Int -> Text -> Text
nameWithNumber issueNum issueTitle =
show issueNum <> "-" <> mkShortDesc issueTitle
mkShortDesc :: Text -> Text
mkShortDesc =
T.intercalate "-"
@ -73,14 +101,30 @@ runNew False issueOrName = do
|| isSpace c
|| c `elem` ("_-./" :: String)
)
runNew _ title =
createIssue' title >>= \case
Left err -> errorMessage $ show err
Right issue -> do
putTextLn . showIssueName blueCode 0 $ issue
runStash
"git" ["checkout", "master"]
runNew False $ show $ unIssueNumber . issueNumber $ issue
-- | @hit new@ command.
runNew :: Bool -> Text -> IO ()
runNew isIssue issueOrName = do
login <- getUsername
maybeIssue <- if isIssue then tryCreateNewIssue login else pure Nothing
let branchDescription = mkBranchDescription maybeIssue issueOrName
title <- displayBranchDescription branchDescription
let branchName = login <> "/" <> title
"git" ["checkout", "-b", branchName]
where
tryCreateNewIssue :: Text -> IO (Maybe IssueNumber)
tryCreateNewIssue login = do
infoMessage $ "Creating issue with title: '" <> issueOrName <> "'"
createIssue issueOrName login >>= \case
Left err -> do
errorMessage "Error creating issue under 'hit new' command!"
putTextLn $ show err
pure Nothing
Right issue -> do
let issueNum = issueNumber issue
successMessage $ "Successfully created issue number #"
<> show (unIssueNumber issueNum)
pure $ Just issueNum
-- | @hit commit@ command.
runCommit :: CommitOptions -> IO ()

115
src/Hit/Issue.hs
View File

@ -1,6 +1,10 @@
{- | This module contains functions to work with issues withing GitHub API.
-}
module Hit.Issue
( runIssue
, createIssue'
( -- * For CLI commands
runIssue
, createIssue
-- * Internal helpers
, mkIssueId
@ -8,8 +12,6 @@ module Hit.Issue
, getOwnerRepo
, parseOwnerRepo
, showIssueName
, issueNumber
, unIssueNumber
) where
import Data.Vector (Vector)
@ -17,7 +19,7 @@ import GitHub (Error (..), Id, Issue (..), IssueLabel (..), IssueState (..), Nam
SimpleUser (..), User, getUrl, mkId, mkName, unIssueNumber, untagName)
import GitHub.Auth (Auth (OAuth))
import GitHub.Data.Options (stateOpen)
import GitHub.Endpoints.Issues (createIssue, issue', issuesForRepo', newIssue)
import GitHub.Endpoints.Issues (NewIssue (..), issue', issuesForRepo')
import Shellmet (($|))
import System.Environment (lookupEnv)
@ -27,7 +29,11 @@ import qualified Hit.Formatting as Fmt
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified GitHub.Endpoints.Issues as GitHub
----------------------------------------------------------------------------
-- CLI for issues
----------------------------------------------------------------------------
-- | Run the @issue@ command.
runIssue :: Maybe Int -> Maybe Text -> IO ()
@ -35,7 +41,9 @@ runIssue issue me = case issue of
Just num -> getIssue $ mkIssueId num
Nothing -> getAllIssues me
-- | Get the list of the opened issues for the current project.
{- | Get the list of the opened issues for the current project and
display short information about each issue.
-}
getAllIssues :: Maybe Text -> IO ()
getAllIssues me = withOwnerRepo (\t o r -> issuesForRepo' t o r stateOpen) >>= \case
Left err -> errorMessage $ show err
@ -55,12 +63,7 @@ getAllIssues me = withOwnerRepo (\t o r -> issuesForRepo' t o r stateOpen) >>= \
assignedTo :: Name User -> Vector SimpleUser -> Bool
assignedTo user = isJust . V.find ((user ==) . simpleUserLogin)
-- | Get the 'Issue' by given issue number.
getIssue :: Id Issue -> IO ()
getIssue num = fetchIssue num >>= \case
Left err -> errorMessage $ show err
Right is -> putTextLn $ showIssueFull is
-- | Show issue number with alignment and its name.
showIssueName :: Text -> Int -> Issue -> Text
showIssueName colorCode padSize Issue{..} =
arrow <> colorCode <> " [#" <> show (unIssueNumber issueNumber) <> "] " <> padding <> resetCode <> issueTitle
@ -68,6 +71,11 @@ showIssueName colorCode padSize Issue{..} =
padding :: Text
padding = T.replicate padSize " "
-- | Get the 'Issue' by given issue number and pretty print it fully to terminal.
getIssue :: Id Issue -> IO ()
getIssue num = fetchIssue num >>= putTextLn . showIssueFull
-- | Show full information about the issue.
showIssueFull :: Issue -> Text
showIssueFull i@Issue{..} = T.intercalate "\n" $
showIssueName (statusToCode issueState) 0 i
@ -103,55 +111,72 @@ showIssueFull i@Issue{..} = T.intercalate "\n" $
highlight :: Text -> Text
highlight x = boldCode <> greenCode <> x <> resetCode
-- | Create an 'Issue' by given 'Text'
createIssue' :: Text -> IO (Either Error Issue)
createIssue' title = getOwnerRepo >>= \case
Just (owner, repo) -> do
token <- gitHubToken
case token of
Just oAuth -> createIssue oAuth owner repo (newIssue title)
Nothing -> do
let errTxt = "Can not get GITHUB_TOKEN"
errorMessage errTxt
pure $ Left $ ParseError errTxt
-- | Create an 'Issue' by given title 'Text'
-- QUESTION: should we create 'Login' newtype to add more type-safety here?
createIssue :: Text -> Text -> IO (Either Error Issue)
createIssue title login = withOwnerRepo $ \token owner repo -> case token of
Just oAuth -> GitHub.createIssue oAuth owner repo $ mkNewIssue title login
Nothing -> do
errorMessage noOwnerRepoError
pure $ Left $ ParseError noOwnerRepoError
let errorText = "Can not get GITHUB_TOKEN"
errorMessage errorText
pure $ Left $ ParseError errorText
mkIssueId :: Int -> Id Issue
mkIssueId = mkId $ Proxy @Issue
makeName :: forall a . Text -> Name a
makeName = mkName (Proxy @a)
fetchIssue :: Id Issue -> IO (Either Error Issue)
fetchIssue iNum = withOwnerRepo (\t o r -> issue' t o r iNum)
----------------------------------------------------------------------------
-- Helper functions
----------------------------------------------------------------------------
-- | Fetch only issue title.
getIssueTitle :: Id Issue -> IO Text
getIssueTitle num = fetchIssue num >>= \case
Left err -> errorMessage (show err) >> exitFailure
Right Issue{..} -> pure issueTitle
getIssueTitle num = issueTitle <$> fetchIssue num
{- | Fetch 'Issue' by 'Id'. If no issue found then print error and
exit with failure.
-}
fetchIssue :: Id Issue -> IO Issue
fetchIssue iNum = withOwnerRepo (\t o r -> issue' t o r iNum) >>= \case
Left err -> errorMessage (show err) >> exitFailure
Right issue -> pure issue
-- | Perform action by given auth token, owner and repo name.
withOwnerRepo
:: (Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error a))
-> IO (Either Error a)
withOwnerRepo action = getOwnerRepo >>= \case
Just (owner, repo) -> do
token <- gitHubToken
token <- getGitHubToken
action token owner repo
Nothing -> do
errorMessage noOwnerRepoError
pure $ Left $ ParseError noOwnerRepoError
let errorText = "Cannot get the owner/repo names"
errorMessage errorText
pure $ Left $ ParseError errorText
-- | Get GITHUB_TOKEN from environment variables
gitHubToken :: IO (Maybe Auth)
gitHubToken = do
-- | Smart constructor for @'Id' 'Issue'@.
mkIssueId :: Int -> Id Issue
mkIssueId = mkId $ Proxy @Issue
-- | Smart constructor for 'Name'.
makeName :: forall a . Text -> Name a
makeName = mkName (Proxy @a)
-- | Create new issue with title and assignee.
mkNewIssue :: Text -> Text -> NewIssue
mkNewIssue title login = NewIssue
{ newIssueTitle = title
, newIssueBody = Nothing
, newIssueAssignees = V.singleton $ makeName @User login
, newIssueMilestone = Nothing
, newIssueLabels = Nothing
}
-- | Get authentication GitHub token from the environment variable @GITHUB_TOKEN@.
getGitHubToken :: IO (Maybe Auth)
getGitHubToken = do
token <- lookupEnv "GITHUB_TOKEN"
pure $ OAuth . encodeUtf8 <$> token
-- | Error message when the owner/repo cannot be get
noOwnerRepoError :: Text
noOwnerRepoError = "Cannot get the owner/repo names"
----------------------------------------------------------------------------
-- Fetch and parse name and repo from URL
----------------------------------------------------------------------------
-- | Get the owner and the repository name.
getOwnerRepo :: IO (Maybe (Name Owner, Name Repo))

7
src/Prelude.hs
View File

@ -1,7 +0,0 @@
-- | Uses [relude](https://hackage.haskell.org/package/relude) as default Prelude.
module Prelude
( module Relude
) where
import Relude

3
stack.yaml
View File

@ -2,6 +2,7 @@ resolver: lts-14.7
extra-deps:
- github-0.23
- optparse-applicative-0.15.1.0
- relude-0.6.0.0
- shellmet-0.0.1
- shellmet-0.0.3.0
- binary-instances-1@sha256:b17565598b8df3241f9b46fa8e3a3368ecc8e3f2eb175d7c28f319042a6f5c79,2613