mirror of
https://github.com/kowainik/hit-on.git
synced 2024-09-11 12:15:46 +03:00
* [#177] `hit milestones` command to get the list of open milestones Resolves #177 * Fix Hlint
This commit is contained in:
parent
8ac810a0e8
commit
fe44a48000
@ -42,6 +42,8 @@ The changelog is available [on GitHub][2].
|
||||
Ignore dots (`.`) in the branch names to avoid `git` failures.
|
||||
* [#155](https://github.com/kowainik/hit-on/issues/155):
|
||||
Notify on an empty list of the issues.
|
||||
* [#177](https://github.com/kowainik/hit-on/issues/177):
|
||||
Add `hit milestones` command to show all open milestones.
|
||||
|
||||
|
||||
### 0.1.0.0 — Aug 3, 2019
|
||||
|
@ -75,6 +75,7 @@ library
|
||||
Hit.Git.Fresh
|
||||
Hit.Git.Hop
|
||||
Hit.Git.Log
|
||||
Hit.Git.Milestones
|
||||
Hit.Git.New
|
||||
Hit.Git.Push
|
||||
Hit.Git.Resolve
|
||||
@ -84,6 +85,7 @@ library
|
||||
Hit.Git.Uncommit
|
||||
Hit.Git.Unstash
|
||||
Hit.Git.Wip
|
||||
Hit.GitHub
|
||||
Hit.Prompt
|
||||
Hit.Issue
|
||||
|
||||
|
@ -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, runNew, runPush, runResolve, runStash, runStatus, runSync,
|
||||
runUncommit, runUnstash, runWip)
|
||||
runHop, runLog, runMilestones, runNew, runPush, runResolve, runStash, runStatus,
|
||||
runSync, runUncommit, runUnstash, runWip)
|
||||
import Hit.Issue (runIssue)
|
||||
import Hit.Prompt (arrow)
|
||||
|
||||
@ -57,6 +57,7 @@ hit = execParser cliParser >>= \case
|
||||
Diff commit -> runDiff commit
|
||||
Clone name -> runClone name
|
||||
Log commit -> runLog commit
|
||||
Milestones -> runMilestones
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
-- Parsers
|
||||
@ -94,6 +95,7 @@ data HitCommand
|
||||
| Diff (Maybe Text)
|
||||
| Clone Text
|
||||
| Log (Maybe Text)
|
||||
| Milestones
|
||||
|
||||
-- | Commands parser.
|
||||
hitP :: Parser HitCommand
|
||||
@ -118,6 +120,7 @@ hitP = subparser
|
||||
<> com "diff" diffP "Display beautiful diff with COMMIT_HASH (by default HEAD)"
|
||||
<> com "clone" cloneP "Clone the repo. Use 'reponame' or 'username/reponame' formats"
|
||||
<> com "log" logP "Display the log of the current commit or COMMIT_HASH"
|
||||
<> com "milestones" milestonesP "Show the list of open milestones for the project"
|
||||
where
|
||||
com :: String -> Parser HitCommand -> String -> Mod CommandFields HitCommand
|
||||
com name p desc = command name (info (helper <*> p) $ progDesc desc)
|
||||
@ -214,6 +217,9 @@ logP = Log <$> maybeCommitP
|
||||
wipP :: Parser HitCommand
|
||||
wipP = pure Wip
|
||||
|
||||
milestonesP :: Parser HitCommand
|
||||
milestonesP = pure Milestones
|
||||
|
||||
-- | Parse optional branch name as an argument.
|
||||
maybeBranchP :: Parser (Maybe Text)
|
||||
maybeBranchP = optional $ strArgument $ metavar "BRANCH_NAME"
|
||||
|
@ -29,6 +29,7 @@ module Hit.Git
|
||||
, runDiff
|
||||
, runClone
|
||||
, runLog
|
||||
, runMilestones
|
||||
|
||||
, getUsername
|
||||
) where
|
||||
@ -44,6 +45,7 @@ import Hit.Git.Fix (runFix)
|
||||
import Hit.Git.Fresh (runFresh)
|
||||
import Hit.Git.Hop (runHop)
|
||||
import Hit.Git.Log (runLog)
|
||||
import Hit.Git.Milestones (runMilestones)
|
||||
import Hit.Git.New (runNew)
|
||||
import Hit.Git.Push (runPush)
|
||||
import Hit.Git.Resolve (runResolve)
|
||||
|
49
src/Hit/Git/Milestones.hs
Normal file
49
src/Hit/Git/Milestones.hs
Normal file
@ -0,0 +1,49 @@
|
||||
{- |
|
||||
Module : Hit.Git.Milestones
|
||||
Copyright : (c) 2020 Kowainik
|
||||
SPDX-License-Identifier : MPL-2.0
|
||||
Maintainer : Kowainik <xrom.xkov@gmail.com>
|
||||
Stability : Stable
|
||||
Portability : Portable
|
||||
|
||||
@hit milestones@ command runner and helpers.
|
||||
-}
|
||||
|
||||
module Hit.Git.Milestones
|
||||
( runMilestones
|
||||
) where
|
||||
|
||||
import Colourista (blue, errorMessage, formatWith, italic, yellow)
|
||||
import Colourista.Short (b)
|
||||
import GitHub (Milestone (..), untagId)
|
||||
import GitHub.Endpoints.Issues.Milestones (milestones')
|
||||
|
||||
import Hit.GitHub (withOwnerRepo)
|
||||
import Hit.Prompt (arrow)
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
|
||||
{- | @hit milestones@ command.
|
||||
|
||||
Fetches all open milestones sorted by ID. The more recent ID would be shown the
|
||||
first.
|
||||
-}
|
||||
runMilestones :: IO ()
|
||||
runMilestones = withOwnerRepo milestones' >>= \case
|
||||
Left err -> do
|
||||
errorMessage ("Could not fetch the milestones\n " <> show err)
|
||||
exitFailure
|
||||
Right ms -> for_ (sortWith (Down . untagId . milestoneNumber) $ toList ms) $ \m ->
|
||||
|
||||
putTextLn $ arrow <> prettyMilestone m
|
||||
|
||||
prettyMilestone :: Milestone -> Text
|
||||
prettyMilestone Milestone{..} =
|
||||
formatWith [blue] (" [#" <> show (untagId milestoneNumber) <> "] ")
|
||||
<> b milestoneTitle
|
||||
<> formatWith [yellow, italic] (" (" <> show milestoneOpenIssues <> "/" <> show (milestoneOpenIssues + milestoneClosedIssues) <> ")")
|
||||
<> case T.strip <$> milestoneDescription of
|
||||
Just "" -> ""
|
||||
Just desc -> "\n " <> desc
|
||||
Nothing -> ""
|
119
src/Hit/GitHub.hs
Normal file
119
src/Hit/GitHub.hs
Normal file
@ -0,0 +1,119 @@
|
||||
{- |
|
||||
Module : Hit.GitHub
|
||||
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 GitHub API.
|
||||
-}
|
||||
|
||||
module Hit.GitHub
|
||||
( withOwnerRepo
|
||||
, withAuthOwnerRepo
|
||||
|
||||
, makeName
|
||||
, getGitHubToken
|
||||
|
||||
-- * GitHub URLs
|
||||
, getOwnerRepo
|
||||
, parseOwnerRepo
|
||||
) where
|
||||
|
||||
import Colourista (errorMessage)
|
||||
import GitHub (Error (..), Name, Owner, Repo, mkName)
|
||||
import GitHub.Auth (Auth (OAuth))
|
||||
import Shellmet (($|))
|
||||
import System.Environment (lookupEnv)
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
|
||||
-- | 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 <- getGitHubToken
|
||||
action token owner repo
|
||||
Nothing -> do
|
||||
let errorText = "Cannot get the owner/repo names"
|
||||
errorMessage errorText
|
||||
pure $ Left $ ParseError errorText
|
||||
|
||||
{- | Similar to 'withOwnerRepo', but returns the 'UserError' when cannot get the
|
||||
GitHub Token, as the given action should work with the 'Auth' instead of 'Maybe
|
||||
Auth'.
|
||||
-}
|
||||
withAuthOwnerRepo
|
||||
:: (Auth -> Name Owner -> Name Repo -> IO (Either Error a))
|
||||
-> IO (Either Error a)
|
||||
withAuthOwnerRepo action = withOwnerRepo $ \token owner repo -> case token of
|
||||
Just auth -> action auth owner repo
|
||||
Nothing -> do
|
||||
let errorText = "Can not get GITHUB_TOKEN"
|
||||
errorMessage errorText
|
||||
pure $ Left $ UserError errorText
|
||||
|
||||
-- | Smart constructor for 'Name'.
|
||||
makeName :: forall a . Text -> Name a
|
||||
makeName = mkName (Proxy @a)
|
||||
|
||||
-- | Get authentication GitHub token from the environment variable @GITHUB_TOKEN@.
|
||||
getGitHubToken :: IO (Maybe Auth)
|
||||
getGitHubToken = do
|
||||
token <- lookupEnv "GITHUB_TOKEN"
|
||||
pure $ OAuth . encodeUtf8 <$> token
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
-- Fetch and parse name and repo from URL
|
||||
----------------------------------------------------------------------------
|
||||
|
||||
-- | Get the owner and the repository name.
|
||||
getOwnerRepo :: IO (Maybe (Name Owner, Name Repo))
|
||||
getOwnerRepo = parseOwnerRepo <$> "git" $| ["remote", "get-url", "origin"]
|
||||
|
||||
{- |
|
||||
__Note:__ this works with GitHub projects!
|
||||
|
||||
This function supports four kinds of the URLs:
|
||||
|
||||
SSH one:
|
||||
|
||||
@
|
||||
git@github.com:kowainik/hit-on.git
|
||||
@
|
||||
|
||||
or
|
||||
|
||||
@
|
||||
git@github.com:kowainik/hit-on
|
||||
@
|
||||
|
||||
And HTTPS one:
|
||||
|
||||
@
|
||||
https://github.com/kowainik/hit-on.git
|
||||
@
|
||||
|
||||
or
|
||||
|
||||
@
|
||||
https://github.com/kowainik/hit-on
|
||||
@
|
||||
-}
|
||||
parseOwnerRepo :: Text -> Maybe (Name Owner, Name Repo)
|
||||
parseOwnerRepo url =
|
||||
( T.stripPrefix "git@github.com:" url
|
||||
<|> T.stripPrefix "https://github.com/" url
|
||||
) >>= stripGitSuffix >>= separateName
|
||||
where
|
||||
separateName :: Text -> Maybe (Name Owner, Name Repo)
|
||||
separateName nm =
|
||||
let (owner, T.drop 1 -> repo) = T.breakOn "/" nm in
|
||||
guard (owner /= "" && repo /= "") *> Just (makeName owner, makeName repo)
|
||||
|
||||
stripGitSuffix :: Text -> Maybe Text
|
||||
stripGitSuffix x = whenNothing (T.stripSuffix ".git" x) (Just x)
|
101
src/Hit/Issue.hs
101
src/Hit/Issue.hs
@ -19,26 +19,21 @@ module Hit.Issue
|
||||
-- * Internal helpers
|
||||
, mkIssueId
|
||||
, getIssueTitle
|
||||
, getOwnerRepo
|
||||
, parseOwnerRepo
|
||||
, showIssueName
|
||||
) where
|
||||
|
||||
import Colourista (blue, blueBg, bold, errorMessage, formatWith, green, red, reset, skipMessage,
|
||||
successMessage, warningMessage)
|
||||
import Data.Vector (Vector)
|
||||
import GitHub (Error (..), Id, Issue (..), IssueLabel (..), IssueState (..), Name, Owner, Repo,
|
||||
SimpleUser (..), User, getUrl, milestoneNumber, mkId, mkName, unIssueNumber, untagId,
|
||||
untagName)
|
||||
import GitHub.Auth (Auth (OAuth))
|
||||
import GitHub (Error (..), Id, Issue (..), IssueLabel (..), IssueState (..), Name, SimpleUser (..),
|
||||
User, getUrl, milestoneNumber, mkId, unIssueNumber, untagId, untagName)
|
||||
import GitHub.Data.Options (stateOpen)
|
||||
import GitHub.Endpoints.Issues (EditIssue (..), NewIssue (..), editOfIssue, issue', issuesForRepo')
|
||||
import GitHub.Endpoints.Issues.Milestones (milestones')
|
||||
import Shellmet (($|))
|
||||
import System.Environment (lookupEnv)
|
||||
|
||||
import Hit.Core (IssueOptions (..), Milestone (..))
|
||||
import Hit.Git.Common (getUsername)
|
||||
import Hit.GitHub (makeName, withAuthOwnerRepo, withOwnerRepo)
|
||||
import Hit.Prompt (arrow)
|
||||
|
||||
import qualified Hit.Formatting as Fmt
|
||||
@ -239,45 +234,14 @@ message and returns 'Nothing'.
|
||||
fetchCurrentMilestoneId :: IO (Maybe Int)
|
||||
fetchCurrentMilestoneId = withOwnerRepo milestones' >>= \case
|
||||
Left err -> Nothing <$ warningMessage ("Could not fetch the milestones\n " <> show err)
|
||||
Right ms -> case sortBy (flip compare) $ map (untagId . milestoneNumber) $ toList ms of
|
||||
Right ms -> case sortWith Down $ map (untagId . milestoneNumber) $ toList ms of
|
||||
[] -> warningMessage "There are no open milestones for this project" >> pure Nothing
|
||||
m:_ -> pure $ Just m
|
||||
|
||||
-- | 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 <- getGitHubToken
|
||||
action token owner repo
|
||||
Nothing -> do
|
||||
let errorText = "Cannot get the owner/repo names"
|
||||
errorMessage errorText
|
||||
pure $ Left $ ParseError errorText
|
||||
|
||||
{- | Similar to 'withOwnerRepo', but returns the 'UserError' when cannot get the
|
||||
GitHub Token, as the given action should work with the 'Auth' instead of 'Maybe
|
||||
Auth'.
|
||||
-}
|
||||
withAuthOwnerRepo
|
||||
:: (Auth -> Name Owner -> Name Repo -> IO (Either Error a))
|
||||
-> IO (Either Error a)
|
||||
withAuthOwnerRepo action = withOwnerRepo $ \token owner repo -> case token of
|
||||
Just auth -> action auth owner repo
|
||||
Nothing -> do
|
||||
let errorText = "Can not get GITHUB_TOKEN"
|
||||
errorMessage errorText
|
||||
pure $ Left $ UserError errorText
|
||||
|
||||
-- | 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
|
||||
@ -287,60 +251,3 @@ mkNewIssue title login = NewIssue
|
||||
, 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
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
-- Fetch and parse name and repo from URL
|
||||
----------------------------------------------------------------------------
|
||||
|
||||
-- | Get the owner and the repository name.
|
||||
getOwnerRepo :: IO (Maybe (Name Owner, Name Repo))
|
||||
getOwnerRepo = parseOwnerRepo <$> "git" $| ["remote", "get-url", "origin"]
|
||||
|
||||
{- |
|
||||
__Note:__ this works with GitHub projects!
|
||||
|
||||
This function supports four kinds of the URLs:
|
||||
|
||||
SSH one:
|
||||
|
||||
@
|
||||
git@github.com:kowainik/hit-on.git
|
||||
@
|
||||
|
||||
or
|
||||
|
||||
@
|
||||
git@github.com:kowainik/hit-on
|
||||
@
|
||||
|
||||
And HTTPS one:
|
||||
|
||||
@
|
||||
https://github.com/kowainik/hit-on.git
|
||||
@
|
||||
|
||||
or
|
||||
|
||||
@
|
||||
https://github.com/kowainik/hit-on
|
||||
@
|
||||
-}
|
||||
parseOwnerRepo :: Text -> Maybe (Name Owner, Name Repo)
|
||||
parseOwnerRepo url =
|
||||
( T.stripPrefix "git@github.com:" url
|
||||
<|> T.stripPrefix "https://github.com/" url
|
||||
) >>= stripGitSuffix >>= separateName
|
||||
where
|
||||
separateName :: Text -> Maybe (Name Owner, Name Repo)
|
||||
separateName nm =
|
||||
let (owner, T.drop 1 -> repo) = T.breakOn "/" nm in
|
||||
guard (owner /= "" && repo /= "") *> Just (makeName owner, makeName repo)
|
||||
|
||||
stripGitSuffix :: Text -> Maybe Text
|
||||
stripGitSuffix x = whenNothing (T.stripSuffix ".git" x) (Just x)
|
||||
|
@ -1,10 +1,9 @@
|
||||
|
||||
module Main (main) where
|
||||
|
||||
import GitHub.Data.Name (Name (..))
|
||||
import Test.Hspec (describe, hspec, it, shouldBe)
|
||||
|
||||
import Hit.Issue (parseOwnerRepo)
|
||||
import Hit.GitHub (parseOwnerRepo)
|
||||
|
||||
|
||||
main :: IO ()
|
||||
@ -29,4 +28,3 @@ main = hspec $ do
|
||||
parseOwnerRepo "https://github.com/kowainik" `shouldBe` Nothing
|
||||
it "Parses an invalid GitHub repo link and returns a `Nothing`" $ do
|
||||
parseOwnerRepo "git@github.com" `shouldBe` Nothing
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user