[#177] hit milestones command to get the list of open milestones (#179)

* [#177] `hit milestones` command to get the list of open milestones

Resolves #177

* Fix Hlint

CHANGELOG.md

@@ -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

hit-on.cabal

@@ -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
 

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, 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"

src/Hit/Git.hs

@@ -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)

src/Hit/Git/Milestones.hs

@@ -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   -> ""

src/Hit/GitHub.hs

@@ -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)

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)

test/Main.hs

@@ -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
-