mirror of
https://github.com/kowainik/hit-on.git
synced 2024-10-26 11:47:25 +03:00
Create tests for all GitHub API functions
This commit is contained in:
parent
15dd9b4c66
commit
967d1793bd
@ -3,4 +3,4 @@ packages: .
|
||||
source-repository-package
|
||||
type: git
|
||||
location: git@github.com:kowainik/github-graphql.git
|
||||
tag: fad9692bce2795643f4ef4bb0a7052ca43d07719
|
||||
tag: bda3e6baceb1bdfd156afa851fc1d6f5e653771b
|
16
hit-on.cabal
16
hit-on.cabal
@ -27,6 +27,7 @@ common common-options
|
||||
|
||||
mixins: base hiding (Prelude)
|
||||
, relude (Relude as Prelude
|
||||
, Relude.Extra.Bifunctor
|
||||
, Relude.Extra.Enum
|
||||
)
|
||||
|
||||
@ -115,6 +116,7 @@ library
|
||||
, github-graphql ^>= 0.0
|
||||
, gitrev ^>= 1.3
|
||||
, optparse-applicative ^>= 0.15
|
||||
, pretty-simple ^>= 4.0
|
||||
, process ^>= 1.6
|
||||
, prolens ^>= 0.0
|
||||
, shellmet ^>= 0.0.3.0
|
||||
@ -134,12 +136,20 @@ test-suite hit-on-test
|
||||
import: common-options
|
||||
type: exitcode-stdio-1.0
|
||||
hs-source-dirs: test
|
||||
main-is: Main.hs
|
||||
other-modules: Test.Hit.Names
|
||||
main-is: Spec.hs
|
||||
other-modules: Test.Hit.Data
|
||||
Test.Hit.Names
|
||||
Test.Hit.Parse
|
||||
Test.Hit.GitHub
|
||||
Test.Hit.GitHub.Issue
|
||||
Test.Hit.GitHub.Milestone
|
||||
Test.Hit.GitHub.PullRequest
|
||||
Test.Hit.GitHub.User
|
||||
|
||||
build-depends: text
|
||||
build-depends: github-graphql
|
||||
, hspec ^>= 2.7.1
|
||||
, hit-on
|
||||
, text
|
||||
|
||||
ghc-options: -threaded
|
||||
-rtsopts
|
||||
|
@ -47,7 +47,8 @@ newtype Repo = Repo
|
||||
-}
|
||||
newtype IssueNumber = IssueNumber
|
||||
{ unIssueNumber :: Int
|
||||
} deriving newtype (FromJSON)
|
||||
} deriving stock (Show)
|
||||
deriving newtype (Eq, FromJSON)
|
||||
|
||||
{- | Data type to represent the type of @push@ or @sync@: force-push
|
||||
(force-reset) or not.
|
||||
|
@ -14,9 +14,15 @@ module Hit.Error
|
||||
, renderHitError
|
||||
) where
|
||||
|
||||
import Text.Pretty.Simple (pShow)
|
||||
|
||||
import qualified GitHub as GH
|
||||
|
||||
|
||||
data HitError
|
||||
= NoGitHubTokenEnv
|
||||
| InvalidOwnerRepo
|
||||
| GitHubApiError GH.GitHubError
|
||||
|
||||
renderHitError :: HitError -> Text
|
||||
renderHitError = \case
|
||||
@ -24,3 +30,5 @@ renderHitError = \case
|
||||
"The environment variable GITHUB_TOKEN is not set"
|
||||
InvalidOwnerRepo ->
|
||||
"Can't parse the 'owner' and 'repo' names from the 'owner/repo' format"
|
||||
GitHubApiError err ->
|
||||
"Error calling GitHub API:\n\n" <> toStrict (pShow err)
|
||||
|
@ -21,9 +21,9 @@ module Hit.Git.Branch
|
||||
, mkBranchDescription
|
||||
) where
|
||||
|
||||
import Data.Char (isAlphaNum, isDigit, isSpace)
|
||||
|
||||
import Colourista (errorMessage, infoMessage, successMessage, warningMessage)
|
||||
import Data.Char (isAlphaNum, isDigit, isSpace)
|
||||
import Relude.Extra.Bifunctor (secondF)
|
||||
import Shellmet (($?))
|
||||
|
||||
import Hit.Core (IssueNumber (..), MilestoneOption, NewOptions (..), newOptionsWithName)
|
||||
@ -196,9 +196,16 @@ showIssueLink url = infoMessage $ " Issue link: " <> url
|
||||
createIssue :: Text -> Maybe MilestoneOption -> IO (Either HitError CreatedIssue)
|
||||
createIssue title milestoneOpt = withAuthOwnerRepo $ \token owner repo -> do
|
||||
-- TODO: optimize to 2 calls instead of 3
|
||||
-- Also, it's so awkward to work with 'IO (Either ...)', but there's no better way...
|
||||
milestoneNumber <- getMilestoneNumber milestoneOpt
|
||||
milestoneId <- traverse (queryMilestoneId token owner repo) milestoneNumber
|
||||
mutationCreateNewIssue token owner repo title milestoneId
|
||||
|
||||
eMilestoneId <- case milestoneNumber of
|
||||
Nothing -> pure $ Right Nothing
|
||||
Just mId -> secondF Just $ queryMilestoneId token owner repo mId
|
||||
|
||||
case eMilestoneId of
|
||||
Left err -> pure $ Left err
|
||||
Right milestoneId -> mutationCreateNewIssue token owner repo title milestoneId
|
||||
|
||||
{- | Assign the user to the given 'Issue'.
|
||||
|
||||
@ -214,8 +221,8 @@ assignToIssue :: Issue -> Text -> IO ()
|
||||
assignToIssue Issue{..} username = do
|
||||
res <- withAuthOwnerRepo $ \token _owner _repo ->
|
||||
if username `elem` issueAssignees
|
||||
then pure (issueNumber, True)
|
||||
else (, False) <$> addAssignee token issueId
|
||||
then pure $ Right (issueNumber, True)
|
||||
else secondF (, False) (addAssignee token issueId)
|
||||
|
||||
case res of
|
||||
Right (iss, isAlreadyAssigned) ->
|
||||
@ -226,7 +233,7 @@ assignToIssue Issue{..} username = do
|
||||
errorMessage "Can not assign you to the issue."
|
||||
putTextLn $ " " <> renderHitError err
|
||||
|
||||
addAssignee :: GH.GitHubToken -> GH.IssueId -> IO IssueNumber
|
||||
addAssignee token issueId = do
|
||||
myId <- queryMyId token
|
||||
assignUserToIssue token myId issueId
|
||||
addAssignee :: GH.GitHubToken -> GH.IssueId -> IO (Either GH.GitHubError IssueNumber)
|
||||
addAssignee token issueId = queryMyId token >>= \case
|
||||
Left err -> pure $ Left err
|
||||
Right myId -> assignUserToIssue token myId issueId
|
||||
|
@ -15,6 +15,7 @@ module Hit.Git.Milestones
|
||||
|
||||
import Colourista (blue, cyan, errorMessage, formatWith, italic, yellow)
|
||||
import Colourista.Short (b)
|
||||
import Text.Printf (printf)
|
||||
|
||||
import Hit.Error (renderHitError)
|
||||
import Hit.GitHub (Milestone (..), MilestoneNumber (..), queryMilestoneList, withAuthOwnerRepo)
|
||||
@ -46,7 +47,7 @@ prettyMilestone Milestone{..} = mconcat
|
||||
, ")"
|
||||
]
|
||||
, " "
|
||||
, formatWith [cyan] $ show milestoneProgressPercentage <> "%"
|
||||
, formatWith [cyan] $ prettyDouble milestoneProgressPercentage
|
||||
, case Text.strip milestoneDescription of
|
||||
"" -> ""
|
||||
desc -> "\n " <> desc
|
||||
@ -54,9 +55,17 @@ prettyMilestone Milestone{..} = mconcat
|
||||
where
|
||||
milestoneOpenIssues :: Int
|
||||
milestoneOpenIssues = round
|
||||
$ fromIntegral milestoneTotalIssues * milestoneProgressPercentage
|
||||
$ (fromIntegral milestoneTotalIssues * milestoneProgressPercentage) / 100
|
||||
|
||||
fetchMilestones :: IO [Milestone]
|
||||
fetchMilestones = withAuthOwnerRepo queryMilestoneList >>= \case
|
||||
Left err -> errorMessage (renderHitError err) >> exitFailure
|
||||
Right ms -> pure ms
|
||||
|
||||
{- | Show double prettily with only 2 digits after dot.
|
||||
-}
|
||||
prettyDouble :: Double -> Text
|
||||
prettyDouble x =
|
||||
if fromIntegral (floor x :: Int) == x -- display without decimal part
|
||||
then toText (printf "%.0f" x :: String) <> "%"
|
||||
else toText (printf "%.2f" x :: String) <> "%"
|
||||
|
@ -21,7 +21,7 @@ import Hit.Git.Branch (runNew)
|
||||
import Hit.Git.Commit (runCommit)
|
||||
import Hit.Git.Common (getCurrentBranch, getUsername, issueFromBranch, whenOnMainBranch)
|
||||
import Hit.Git.Issue (fetchIssue)
|
||||
import Hit.GitHub (Issue (..), queryPullRequests, withAuthOwnerRepo)
|
||||
import Hit.GitHub (Issue (..), PrTitle (..), queryPullRequests, withAuthOwnerRepo)
|
||||
import Hit.Hub (withHub)
|
||||
|
||||
import qualified Data.Text as Text
|
||||
@ -47,8 +47,9 @@ runPr isDraft = do
|
||||
putTextLn $ " " <> renderHitError err
|
||||
exitFailure
|
||||
Right prs -> case prs of
|
||||
_ : _ -> do
|
||||
errorMessage "PR for the current branch already exists"
|
||||
PrTitle title : _ -> do
|
||||
errorMessage $
|
||||
"PR for the current branch already exists with the name: " <> title
|
||||
exitFailure
|
||||
[] -> do
|
||||
runCommit CommitOptions
|
||||
|
@ -11,9 +11,11 @@ Functions to perform authenticated GitHub API requests.
|
||||
|
||||
module Hit.GitHub.Auth
|
||||
( withAuthOwnerRepo
|
||||
, getGitHubToken
|
||||
, parseOwnerRepo
|
||||
) where
|
||||
|
||||
import Relude.Extra.Bifunctor (firstF)
|
||||
import Shellmet (($|))
|
||||
|
||||
import Hit.Core (Owner (..), Repo (..))
|
||||
@ -28,13 +30,16 @@ import qualified GitHub as GH
|
||||
All actions to query GraphQL GitHub API require authentication token.
|
||||
-}
|
||||
withAuthOwnerRepo
|
||||
:: (GH.GitHubToken -> Owner -> Repo -> IO a)
|
||||
:: (GH.GitHubToken -> Owner -> Repo -> IO (Either GH.GitHubError a))
|
||||
-> IO (Either HitError a)
|
||||
withAuthOwnerRepo action = GH.getGitHubToken "GITHUB_TOKEN" >>= \case
|
||||
withAuthOwnerRepo action = getGitHubToken >>= \case
|
||||
Nothing -> pure $ Left NoGitHubTokenEnv
|
||||
Just token -> getOwnerRepo >>= \case
|
||||
Nothing -> pure $ Left InvalidOwnerRepo
|
||||
Just (owner, repo) -> Right <$> action token owner repo
|
||||
Just (owner, repo) -> firstF GitHubApiError (action token owner repo)
|
||||
|
||||
getGitHubToken :: IO (Maybe GH.GitHubToken)
|
||||
getGitHubToken = GH.getGitHubToken "GITHUB_TOKEN"
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
-- Fetch and parse name and repo from URL
|
||||
|
@ -26,7 +26,7 @@ module Hit.GitHub.Issue
|
||||
, mutationCreateNewIssue
|
||||
) where
|
||||
|
||||
import Data.Aeson (Array, FromJSON (..), withObject, (.:), (.:?))
|
||||
import Data.Aeson (Array, FromJSON (..), Object, Value (..), withObject, (.:))
|
||||
import Data.Aeson.Types (Parser)
|
||||
import Prolens (set)
|
||||
|
||||
@ -52,7 +52,7 @@ data Issue = Issue
|
||||
, issueLabels :: [Text]
|
||||
, issueAssignees :: [Text]
|
||||
, issueMilestoneNumber :: Maybe MilestoneNumber
|
||||
}
|
||||
} deriving stock (Show, Eq)
|
||||
|
||||
instance FromJSON Issue
|
||||
where
|
||||
@ -74,8 +74,7 @@ instance FromJSON Issue
|
||||
assigneesNodes <- assignees .: "nodes"
|
||||
issueAssignees <- parseAssignees assigneesNodes
|
||||
|
||||
milestone <- o .: "milestone"
|
||||
issueMilestoneNumber <- milestone .:? "number"
|
||||
issueMilestoneNumber <- parseMilestoneNumber o
|
||||
|
||||
pure Issue{..}
|
||||
where
|
||||
@ -95,8 +94,9 @@ issueQuery (Owner owner) (Repo repo) (IssueNumber issueNumber) = GH.repository
|
||||
( GH.defIssueArgs
|
||||
& set GH.numberL issueNumber
|
||||
)
|
||||
( GH.title
|
||||
:| [ GH.author $ one GH.login
|
||||
( GH.IssueId
|
||||
:| [ GH.title
|
||||
, GH.author $ one GH.login
|
||||
, GH.IssueBody
|
||||
, GH.IssueNumber
|
||||
, GH.IssueUrl
|
||||
@ -119,9 +119,14 @@ issueQuery (Owner owner) (Repo repo) (IssueNumber issueNumber) = GH.repository
|
||||
|
||||
{- | Queries a single issue by number.
|
||||
-}
|
||||
queryIssue :: GH.GitHubToken -> Owner -> Repo -> IssueNumber -> IO Issue
|
||||
queryIssue
|
||||
:: GH.GitHubToken
|
||||
-> Owner
|
||||
-> Repo
|
||||
-> IssueNumber
|
||||
-> IO (Either GH.GitHubError Issue)
|
||||
queryIssue token owner repo issueNumber =
|
||||
GH.unNested @'[ "repository", "issue" ] <$>
|
||||
GH.unNest @'[ "repository", "issue" ] $
|
||||
GH.queryGitHub
|
||||
token
|
||||
(GH.repositoryToAst $ issueQuery owner repo issueNumber)
|
||||
@ -138,7 +143,7 @@ data ShortIssue = ShortIssue
|
||||
, shortIssueAuthorLogin :: Text
|
||||
, shortIssueAssignees :: [Text]
|
||||
, shortIssueMilestoneNumber :: Maybe MilestoneNumber
|
||||
}
|
||||
} deriving stock (Show, Eq)
|
||||
|
||||
instance FromJSON ShortIssue
|
||||
where
|
||||
@ -152,8 +157,7 @@ instance FromJSON ShortIssue
|
||||
assigneesNodes <- assignees .: "nodes"
|
||||
shortIssueAssignees <- parseAssignees assigneesNodes
|
||||
|
||||
milestone <- o .: "milestone"
|
||||
shortIssueMilestoneNumber <- milestone .:? "number"
|
||||
shortIssueMilestoneNumber <- parseMilestoneNumber o
|
||||
|
||||
pure ShortIssue{..}
|
||||
|
||||
@ -190,19 +194,23 @@ issueListQuery (Owner owner) (Repo repo) = GH.repository
|
||||
, GH.IssueNumber
|
||||
, GH.IssueAssignees
|
||||
$ GH.Assignees
|
||||
( GH.defAssigneesArgs
|
||||
& set GH.lastL 5
|
||||
)
|
||||
(GH.nodes $ one GH.UserLogin)
|
||||
( GH.defAssigneesArgs
|
||||
& set GH.lastL 5
|
||||
)
|
||||
(GH.nodes $ one GH.UserLogin)
|
||||
, GH.IssueMilestone $ one GH.MilestoneNumber
|
||||
]
|
||||
)
|
||||
|
||||
{- | Queries the latest 100 issues of the repository.
|
||||
-}
|
||||
queryIssueList :: GH.GitHubToken -> Owner -> Repo -> IO [ShortIssue]
|
||||
queryIssueList
|
||||
:: GH.GitHubToken
|
||||
-> Owner
|
||||
-> Repo
|
||||
-> IO (Either GH.GitHubError [ShortIssue])
|
||||
queryIssueList token owner repo =
|
||||
GH.unNested @'[ "repository", "issues", "nodes" ] <$>
|
||||
GH.unNest @'[ "repository", "issues", "nodes" ] $
|
||||
GH.queryGitHub
|
||||
token
|
||||
(GH.repositoryToAst $ issueListQuery owner repo)
|
||||
@ -213,7 +221,8 @@ queryIssueList token owner repo =
|
||||
|
||||
newtype IssueTitle = IssueTitle
|
||||
{ unIssueTitle :: Text
|
||||
} deriving newtype (FromJSON)
|
||||
} deriving stock (Show)
|
||||
deriving newtype (Eq, FromJSON)
|
||||
|
||||
issueTitleQuery :: Owner -> Repo -> IssueNumber -> GH.Repository
|
||||
issueTitleQuery (Owner owner) (Repo repo) (IssueNumber issueNumber) = GH.repository
|
||||
@ -230,9 +239,14 @@ issueTitleQuery (Owner owner) (Repo repo) (IssueNumber issueNumber) = GH.reposit
|
||||
|
||||
{- | Queries 'IssueTitle' by number.
|
||||
-}
|
||||
queryIssueTitle :: GH.GitHubToken -> Owner -> Repo -> IssueNumber -> IO IssueTitle
|
||||
queryIssueTitle
|
||||
:: GH.GitHubToken
|
||||
-> Owner
|
||||
-> Repo
|
||||
-> IssueNumber
|
||||
-> IO (Either GH.GitHubError IssueTitle)
|
||||
queryIssueTitle token owner repo issueNumber =
|
||||
GH.unNested @'[ "repository", "issue", "title" ] <$>
|
||||
GH.unNest @'[ "repository", "issue", "title" ] $
|
||||
GH.queryGitHub
|
||||
token
|
||||
(GH.repositoryToAst $ issueTitleQuery owner repo issueNumber)
|
||||
@ -278,13 +292,13 @@ mutationCreateNewIssue
|
||||
-> Repo
|
||||
-> Text
|
||||
-> Maybe GH.MilestoneId
|
||||
-> IO CreatedIssue
|
||||
mutationCreateNewIssue token (Owner owner) (Repo repo) issueTitle milestoneId = do
|
||||
repositoryId <- GH.queryRepositoryId token owner repo
|
||||
|
||||
GH.unNested @'[ "repository", "issue" ] <$> GH.mutationGitHub
|
||||
token
|
||||
(GH.createIssueToAst $ createIssueMutation repositoryId issueTitle milestoneId)
|
||||
-> IO (Either GH.GitHubError CreatedIssue)
|
||||
mutationCreateNewIssue token (Owner owner) (Repo repo) issueTitle milestoneId =
|
||||
GH.queryRepositoryId token owner repo >>= \case
|
||||
Left err -> pure $ Left err
|
||||
Right repositoryId -> GH.unNest @'[ "repository", "issue" ] $ GH.mutationGitHub
|
||||
token
|
||||
(GH.createIssueToAst $ createIssueMutation repositoryId issueTitle milestoneId)
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
-- Internals
|
||||
@ -292,3 +306,12 @@ mutationCreateNewIssue token (Owner owner) (Repo repo) issueTitle milestoneId =
|
||||
|
||||
parseAssignees :: Array -> Parser [Text]
|
||||
parseAssignees = mapM (withObject "Assignee" $ \o -> o .: "login") . toList
|
||||
|
||||
parseMilestoneNumber :: Object -> Parser (Maybe MilestoneNumber)
|
||||
parseMilestoneNumber obj = do
|
||||
-- special parsing of milestone because it can be 'null'
|
||||
milestoneVal <- obj .: "milestone"
|
||||
case milestoneVal of
|
||||
Null -> pure Nothing
|
||||
Object milestone -> milestone .: "number"
|
||||
_ -> fail "Expected 'null' or object with 'number' key"
|
||||
|
@ -57,25 +57,33 @@ latestMilestoneQuery (Owner owner) (Repo repo) = GH.repository
|
||||
$ GH.milestones
|
||||
( GH.defMilestonesArgs
|
||||
& set GH.lastL 1
|
||||
& set GH.statesL (one GH.open)
|
||||
& set GH.orderL
|
||||
( Just $ GH.defMilestoneOrder
|
||||
& set GH.fieldL GH.MNumber
|
||||
& set GH.directionL GH.Desc
|
||||
& set GH.directionL GH.Asc
|
||||
)
|
||||
)
|
||||
(one $ GH.nodes $ one GH.MilestoneNumber)
|
||||
|
||||
{- | Query the number of the latest milestone.
|
||||
-}
|
||||
queryLatestMilestoneNumber :: GH.GitHubToken -> Owner -> Repo -> IO (Maybe MilestoneNumber)
|
||||
queryLatestMilestoneNumber
|
||||
:: GH.GitHubToken
|
||||
-> Owner
|
||||
-> Repo
|
||||
-> IO (Either GH.GitHubError (Maybe MilestoneNumber))
|
||||
queryLatestMilestoneNumber token owner repo = do
|
||||
milestones <-
|
||||
GH.unNested @'[ "repository", "milestones", "nodes" ] <$>
|
||||
eMilestones <-
|
||||
GH.unNest @'[ "repository", "milestones", "nodes" ] $
|
||||
GH.queryGitHub
|
||||
token
|
||||
(GH.repositoryToAst $ latestMilestoneQuery owner repo)
|
||||
|
||||
pure $ case milestones of
|
||||
pure $ second getMilestoneNumber eMilestones
|
||||
where
|
||||
getMilestoneNumber :: [LatestMilestone] -> Maybe MilestoneNumber
|
||||
getMilestoneNumber = \case
|
||||
[] -> Nothing
|
||||
m:_ -> Just $ unLatestMilestone m
|
||||
|
||||
@ -117,6 +125,7 @@ milestonesQuery (Owner owner) (Repo repo) = GH.repository
|
||||
$ GH.milestones
|
||||
( GH.defMilestonesArgs
|
||||
& set GH.lastL 100
|
||||
& set GH.statesL (one GH.open)
|
||||
& set GH.orderL
|
||||
( Just $ GH.defMilestoneOrder
|
||||
& set GH.fieldL GH.MCreatedAt
|
||||
@ -127,8 +136,9 @@ milestonesQuery (Owner owner) (Repo repo) = GH.repository
|
||||
$ GH.nodes
|
||||
$ GH.MilestoneId
|
||||
:| [ GH.MilestoneNumber
|
||||
, GH.MilestoneProgressPercentage
|
||||
, GH.MilestoneTitle
|
||||
, GH.MilestoneDescription
|
||||
, GH.MilestoneProgressPercentage
|
||||
, GH.MilestoneIssues $ GH.Issues
|
||||
( GH.defIssuesArgs
|
||||
& set GH.lastL 1000
|
||||
@ -140,9 +150,13 @@ milestonesQuery (Owner owner) (Repo repo) = GH.repository
|
||||
|
||||
{- | Queries the latest 100 issues of the repository.
|
||||
-}
|
||||
queryMilestoneList :: GH.GitHubToken -> Owner -> Repo -> IO [Milestone]
|
||||
queryMilestoneList
|
||||
:: GH.GitHubToken
|
||||
-> Owner
|
||||
-> Repo
|
||||
-> IO (Either GH.GitHubError [Milestone])
|
||||
queryMilestoneList token owner repo =
|
||||
GH.unNested @'[ "repository", "milestones", "nodes" ] <$>
|
||||
GH.unNest @'[ "repository", "milestones", "nodes" ] $
|
||||
GH.queryGitHub
|
||||
token
|
||||
(GH.repositoryToAst $ milestonesQuery owner repo)
|
||||
@ -153,6 +167,6 @@ queryMilestoneId
|
||||
-> Owner
|
||||
-> Repo
|
||||
-> MilestoneNumber
|
||||
-> IO GH.MilestoneId
|
||||
-> IO (Either GH.GitHubError GH.MilestoneId)
|
||||
queryMilestoneId token (Owner owner) (Repo repo) (MilestoneNumber number) =
|
||||
GH.queryMilestoneId token owner repo number
|
||||
|
@ -12,9 +12,11 @@ PullRequest-related queries and data types.
|
||||
-}
|
||||
|
||||
module Hit.GitHub.PullRequest
|
||||
( queryPullRequests
|
||||
( PrTitle (..)
|
||||
, queryPullRequests
|
||||
) where
|
||||
|
||||
import Data.Aeson (FromJSON (..), withObject, (.:))
|
||||
import Prolens (set)
|
||||
|
||||
import Hit.Core (Owner (..), Repo (..))
|
||||
@ -37,9 +39,24 @@ pullRequestsQuery (Owner owner) (Repo repo) branch = GH.repository
|
||||
)
|
||||
(one $ GH.nodes $ one GH.title)
|
||||
|
||||
queryPullRequests :: GH.GitHubToken -> Owner -> Repo -> Text -> IO [Text]
|
||||
queryPullRequests
|
||||
:: GH.GitHubToken
|
||||
-> Owner
|
||||
-> Repo
|
||||
-> Text
|
||||
-> IO (Either GH.GitHubError [PrTitle])
|
||||
queryPullRequests token owner repo branch =
|
||||
GH.unNested @'[ "repository", "pullRequests", "nodes", "title" ] <$>
|
||||
GH.unNest @'[ "repository", "pullRequests", "nodes" ] $
|
||||
GH.queryGitHub
|
||||
token
|
||||
(GH.repositoryToAst $ pullRequestsQuery owner repo branch)
|
||||
|
||||
newtype PrTitle = PrTitle
|
||||
{ unPriTitle :: Text
|
||||
} deriving stock (Show)
|
||||
deriving newtype (Eq)
|
||||
|
||||
instance FromJSON PrTitle
|
||||
where
|
||||
parseJSON = withObject "PrTitle" $ \o ->
|
||||
PrTitle <$> (o .: "title")
|
||||
|
@ -22,17 +22,21 @@ import qualified GitHub as GH
|
||||
|
||||
|
||||
-- TODO: move to @github-graphql@
|
||||
queryMyId :: GH.GitHubToken -> IO GH.UserId
|
||||
queryMyId :: GH.GitHubToken -> IO (Either GH.GitHubError GH.UserId)
|
||||
queryMyId token =
|
||||
fmap (GH.unNested @'[ "viewer" ])
|
||||
GH.unNest @'[ "viewer" ]
|
||||
$ GH.queryGitHub token
|
||||
$ GH.viewerToAst
|
||||
$ GH.Viewer
|
||||
$ one GH.UserId
|
||||
|
||||
assignUserToIssue :: GH.GitHubToken -> GH.UserId -> GH.IssueId -> IO IssueNumber
|
||||
assignUserToIssue
|
||||
:: GH.GitHubToken
|
||||
-> GH.UserId
|
||||
-> GH.IssueId
|
||||
-> IO (Either GH.GitHubError IssueNumber)
|
||||
assignUserToIssue token userId issueId =
|
||||
fmap (GH.unNested @'[ "number" ])
|
||||
GH.unNest @'[ "number" ]
|
||||
$ GH.mutationGitHub token
|
||||
$ GH.addAssigneesToAssignableToAst
|
||||
$ GH.AddAssigneesToAssignable issueId [userId]
|
||||
|
33
test/Main.hs
33
test/Main.hs
@ -1,33 +0,0 @@
|
||||
module Main (main) where
|
||||
|
||||
import Test.Hspec (describe, hspec, it, shouldBe)
|
||||
|
||||
import Hit.Core (Owner (..), Repo (..))
|
||||
import Hit.GitHub.Auth (parseOwnerRepo)
|
||||
import Test.Hit.Names (namesSpec)
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = hspec $ do
|
||||
namesSpec
|
||||
|
||||
describe "parseOwnerRepo" $ do
|
||||
let expectedOwnerName = Owner "kowainik"
|
||||
let expectedRepoName = Repo "hit-on"
|
||||
let expectedCredentials = Just (expectedOwnerName, expectedRepoName)
|
||||
it "Parses a GitHub repo link (SSH) and gives use the Owner Name and Repo Name separately" $ do
|
||||
parseOwnerRepo "git@github.com:kowainik/hit-on.git" `shouldBe` expectedCredentials
|
||||
it "Parses a GitHub repo link (SSH) and gives use the Owner Name and Repo Name separately" $ do
|
||||
parseOwnerRepo "git@github.com:kowainik/hit-on" `shouldBe` expectedCredentials
|
||||
it "Parses a GitHub repo link (HTTPS) and gives use the Owner Name and Repo Name separately" $ do
|
||||
parseOwnerRepo "https://github.com/kowainik/hit-on.git" `shouldBe` expectedCredentials
|
||||
it "Parses a GitHub repo link (HTTPS) and gives use the Owner Name and Repo Name separately" $ do
|
||||
parseOwnerRepo "https://github.com/kowainik/hit-on" `shouldBe` expectedCredentials
|
||||
it "Parses an invalid GitHub repo link and returns a `Nothing`" $ do
|
||||
parseOwnerRepo "github.com/kowainik/hit-on" `shouldBe` Nothing
|
||||
it "Parses an invalid GitHub repo link and returns a `Nothing`" $ do
|
||||
parseOwnerRepo "https://githu.com/kowainik/hit-on" `shouldBe` Nothing
|
||||
it "Parses an invalid GitHub repo link and returns a `Nothing`" $ 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
|
21
test/Spec.hs
Normal file
21
test/Spec.hs
Normal file
@ -0,0 +1,21 @@
|
||||
module Main (main) where
|
||||
|
||||
import Test.Hspec (hspec)
|
||||
|
||||
import Hit.GitHub.Auth (getGitHubToken)
|
||||
|
||||
import Test.Hit.GitHub (gitHubSpec)
|
||||
import Test.Hit.Names (namesSpec)
|
||||
import Test.Hit.Parse (parseSpec)
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
token <- getGitHubToken >>= \case
|
||||
Nothing -> error "The env variable GITHUB_TOKEN is not set"
|
||||
Just token -> pure token
|
||||
|
||||
hspec $ do
|
||||
parseSpec
|
||||
gitHubSpec token
|
||||
namesSpec
|
13
test/Test/Hit/Data.hs
Normal file
13
test/Test/Hit/Data.hs
Normal file
@ -0,0 +1,13 @@
|
||||
module Test.Hit.Data
|
||||
( testOwner
|
||||
, testRepo
|
||||
) where
|
||||
|
||||
import Hit.Core (Owner (..), Repo (..))
|
||||
|
||||
|
||||
testOwner :: Owner
|
||||
testOwner = Owner "kowainik"
|
||||
|
||||
testRepo :: Repo
|
||||
testRepo = Repo "hit-off"
|
20
test/Test/Hit/GitHub.hs
Normal file
20
test/Test/Hit/GitHub.hs
Normal file
@ -0,0 +1,20 @@
|
||||
module Test.Hit.GitHub
|
||||
( gitHubSpec
|
||||
) where
|
||||
|
||||
import Test.Hspec (Spec, describe)
|
||||
|
||||
import Test.Hit.GitHub.Issue (issueSpec)
|
||||
import Test.Hit.GitHub.Milestone (milestoneSpec)
|
||||
import Test.Hit.GitHub.PullRequest (pullRequestSpec)
|
||||
import Test.Hit.GitHub.User (userSpec)
|
||||
|
||||
import qualified GitHub as GH
|
||||
|
||||
|
||||
gitHubSpec :: GH.GitHubToken -> Spec
|
||||
gitHubSpec token = describe "GitHub API" $ do
|
||||
userSpec token
|
||||
pullRequestSpec token
|
||||
milestoneSpec token
|
||||
issueSpec token
|
100
test/Test/Hit/GitHub/Issue.hs
Normal file
100
test/Test/Hit/GitHub/Issue.hs
Normal file
@ -0,0 +1,100 @@
|
||||
module Test.Hit.GitHub.Issue
|
||||
( issueSpec
|
||||
) where
|
||||
|
||||
import Relude.Extra.Bifunctor (secondF)
|
||||
import Test.Hspec (Spec, describe, it, shouldReturn)
|
||||
|
||||
import Hit.Core (IssueNumber (..))
|
||||
import Hit.GitHub.Issue (Issue (..), IssueTitle (..), ShortIssue (..), queryIssue, queryIssueList,
|
||||
queryIssueTitle)
|
||||
import Hit.GitHub.Milestone (MilestoneNumber (..))
|
||||
import Test.Hit.Data (testOwner, testRepo)
|
||||
|
||||
import qualified GitHub as GH
|
||||
|
||||
|
||||
issueSpec :: GH.GitHubToken -> Spec
|
||||
issueSpec token = describe "Issue" $ do
|
||||
it "queries issue title" $
|
||||
queryIssueTitle
|
||||
token
|
||||
testOwner
|
||||
testRepo
|
||||
(IssueNumber 1)
|
||||
`shouldReturn`
|
||||
Right (IssueTitle "Issue with \"this\" and 'this'")
|
||||
|
||||
it "queries issue not in milestone with multiple assignees" $
|
||||
getIssue 8 `shouldReturn` Right testIssue1
|
||||
|
||||
it "queries issue in milestone with labels" $
|
||||
getIssue 10 `shouldReturn` Right testIssue2
|
||||
|
||||
it "queries list of all open issues" $
|
||||
secondF (take 4) (queryIssueList token testOwner testRepo)
|
||||
`shouldReturn` Right testShortIssues
|
||||
|
||||
where
|
||||
getIssue :: Int -> IO (Either GH.GitHubError Issue)
|
||||
getIssue issueNumber = queryIssue token testOwner testRepo (IssueNumber issueNumber)
|
||||
|
||||
testIssue1 :: Issue
|
||||
testIssue1 = Issue
|
||||
{ issueId = GH.Id "MDU6SXNzdWU1MzQwNDk1MjQ="
|
||||
, issueTitle = "Test 'hit new --issue'"
|
||||
, issueAuthorLogin = "chshersh"
|
||||
, issueBody = "Some description"
|
||||
, issueNumber = IssueNumber 8
|
||||
, issueUrl = "https://github.com/kowainik/hit-off/issues/8"
|
||||
, issueState = GH.open
|
||||
, issueLabels = []
|
||||
, issueAssignees = [ "chshersh", "vrom911" ]
|
||||
, issueMilestoneNumber = Nothing
|
||||
}
|
||||
|
||||
testIssue2 :: Issue
|
||||
testIssue2 = Issue
|
||||
{ issueId = GH.Id "MDU6SXNzdWU2NTMxOTQ0NTI="
|
||||
, issueTitle = "This issue should be in the milestone"
|
||||
, issueAuthorLogin = "vrom911"
|
||||
, issueBody = ""
|
||||
, issueNumber = IssueNumber 10
|
||||
, issueUrl = "https://github.com/kowainik/hit-off/issues/10"
|
||||
, issueState = GH.open
|
||||
, issueLabels = [ "documentation" ]
|
||||
, issueAssignees = [ "vrom911" ]
|
||||
, issueMilestoneNumber = Just $ MilestoneNumber 1
|
||||
}
|
||||
|
||||
testShortIssues :: [ShortIssue]
|
||||
testShortIssues =
|
||||
[ ShortIssue
|
||||
{ shortIssueNumber = IssueNumber 1
|
||||
, shortIssueTitle = "Issue with \"this\" and 'this'"
|
||||
, shortIssueAuthorLogin = "vrom911"
|
||||
, shortIssueAssignees = []
|
||||
, shortIssueMilestoneNumber = Nothing
|
||||
}
|
||||
, ShortIssue
|
||||
{ shortIssueNumber = IssueNumber 8
|
||||
, shortIssueTitle = "Test 'hit new --issue'"
|
||||
, shortIssueAuthorLogin = "chshersh"
|
||||
, shortIssueAssignees = [ "chshersh", "vrom911" ]
|
||||
, shortIssueMilestoneNumber = Nothing
|
||||
}
|
||||
, ShortIssue
|
||||
{ shortIssueNumber = IssueNumber 9
|
||||
, shortIssueTitle = "[RFC] Ignore RFC in issues"
|
||||
, shortIssueAuthorLogin = "vrom911"
|
||||
, shortIssueAssignees = [ ]
|
||||
, shortIssueMilestoneNumber = Just $ MilestoneNumber 1
|
||||
}
|
||||
, ShortIssue
|
||||
{ shortIssueNumber = IssueNumber 10
|
||||
, shortIssueTitle = "This issue should be in the milestone"
|
||||
, shortIssueAuthorLogin = "vrom911"
|
||||
, shortIssueAssignees = [ "vrom911" ]
|
||||
, shortIssueMilestoneNumber = Just $ MilestoneNumber 1
|
||||
}
|
||||
]
|
49
test/Test/Hit/GitHub/Milestone.hs
Normal file
49
test/Test/Hit/GitHub/Milestone.hs
Normal file
@ -0,0 +1,49 @@
|
||||
module Test.Hit.GitHub.Milestone
|
||||
( milestoneSpec
|
||||
) where
|
||||
|
||||
import Test.Hspec (Spec, describe, it, shouldReturn)
|
||||
|
||||
import Hit.GitHub.Milestone (Milestone (..), MilestoneNumber (..), queryLatestMilestoneNumber,
|
||||
queryMilestoneList)
|
||||
import Test.Hit.Data (testOwner, testRepo)
|
||||
|
||||
import qualified GitHub as GH
|
||||
|
||||
|
||||
milestoneSpec :: GH.GitHubToken -> Spec
|
||||
milestoneSpec token = describe "Milestone" $ do
|
||||
it "fetches the latest milestone" $
|
||||
queryLatestMilestoneNumber
|
||||
token
|
||||
testOwner
|
||||
testRepo
|
||||
`shouldReturn`
|
||||
Right (Just $ MilestoneNumber 2)
|
||||
it "fetches the latest milestone" $
|
||||
queryMilestoneList
|
||||
token
|
||||
testOwner
|
||||
testRepo
|
||||
`shouldReturn`
|
||||
Right testMilestones
|
||||
|
||||
testMilestones :: [Milestone]
|
||||
testMilestones =
|
||||
[ Milestone
|
||||
{ milestoneId = "MDk6TWlsZXN0b25lNjcxNDY5MQ=="
|
||||
, milestoneNumber = MilestoneNumber 2
|
||||
, milestoneTitle = "Latest milestone"
|
||||
, milestoneDescription = ""
|
||||
, milestoneProgressPercentage = 0
|
||||
, milestoneTotalIssues = 0
|
||||
}
|
||||
, Milestone
|
||||
{ milestoneId = "MDk6TWlsZXN0b25lNTYzMjE1NQ=="
|
||||
, milestoneNumber = MilestoneNumber 1
|
||||
, milestoneTitle = "One big milestone"
|
||||
, milestoneDescription = "I am a milestone who is never going to be finished"
|
||||
, milestoneProgressPercentage = 33.33333333333333
|
||||
, milestoneTotalIssues = 3
|
||||
}
|
||||
]
|
25
test/Test/Hit/GitHub/PullRequest.hs
Normal file
25
test/Test/Hit/GitHub/PullRequest.hs
Normal file
@ -0,0 +1,25 @@
|
||||
module Test.Hit.GitHub.PullRequest
|
||||
( pullRequestSpec
|
||||
) where
|
||||
|
||||
import Test.Hspec (Spec, describe, it, shouldReturn)
|
||||
|
||||
import Hit.GitHub.PullRequest (PrTitle (..), queryPullRequests)
|
||||
import Test.Hit.Data (testOwner, testRepo)
|
||||
|
||||
import qualified GitHub as GH
|
||||
|
||||
|
||||
pullRequestSpec :: GH.GitHubToken -> Spec
|
||||
pullRequestSpec token = describe "PullRequest" $ do
|
||||
it "doesn't find PR for non-existing branch" $
|
||||
getPRs "non-existing" `shouldReturn` Right []
|
||||
|
||||
it "doesn't find closed PR with existing branch" $
|
||||
getPRs "closed-pr" `shouldReturn` Right []
|
||||
|
||||
it "find open PR" $
|
||||
getPRs "chshersh/test" `shouldReturn` Right [PrTitle "Test PR"]
|
||||
where
|
||||
getPRs :: Text -> IO (Either GH.GitHubError [PrTitle])
|
||||
getPRs = queryPullRequests token testOwner testRepo
|
17
test/Test/Hit/GitHub/User.hs
Normal file
17
test/Test/Hit/GitHub/User.hs
Normal file
@ -0,0 +1,17 @@
|
||||
module Test.Hit.GitHub.User
|
||||
( userSpec
|
||||
) where
|
||||
|
||||
import Test.Hspec (Spec, describe, it, shouldSatisfy)
|
||||
|
||||
import Hit.GitHub.User (queryMyId)
|
||||
|
||||
import qualified GitHub as GH
|
||||
|
||||
|
||||
userSpec :: GH.GitHubToken -> Spec
|
||||
userSpec token = describe "User" $
|
||||
it "can query my own User ID" $
|
||||
queryMyId token >>= (`shouldSatisfy` isRight)
|
||||
-- simply checking that query works;
|
||||
-- we can't compare with any specific ID here
|
@ -12,19 +12,12 @@ import Hit.Git.Common (getMainBranch)
|
||||
|
||||
namesSpec :: Spec
|
||||
namesSpec = describe "Names for branches and commit messages" $ do
|
||||
branchNamesSpec
|
||||
commitMessagesSpec
|
||||
mainBranchSpec
|
||||
commitMessagesSpec
|
||||
branchNamesSpec
|
||||
|
||||
branchNamesSpec :: Spec
|
||||
branchNamesSpec = describe "Branch naming" $ do
|
||||
describe "Existing issue as argument" $ do
|
||||
it "from issue with RFC" $
|
||||
checkName Nothing "117" "117-hit-go-for-branch-switching"
|
||||
it "from issue with dots and symbols" $
|
||||
checkName Nothing "163" "163-Add-tests-commit-msgs-and"
|
||||
it "from issue with preserved special symbols" $
|
||||
checkName Nothing "175" "175-Update-header_information/-in-the-library"
|
||||
describe "Title without issue" $ do
|
||||
it "Simple title" $
|
||||
checkName Nothing "this-should-be-branch-name" "this-should-be-branch-name"
|
||||
@ -39,7 +32,13 @@ branchNamesSpec = describe "Branch naming" $ do
|
||||
checkName (Just $ IssueNumber 100000) "I am a new issue" "100000-I-am-a-new-issue"
|
||||
it "from IssueNumber and title (more than 5 words)" $
|
||||
checkName (Just $ IssueNumber 100000) "I am a new issue in here" "100000-I-am-a-new-issue"
|
||||
|
||||
describe "Existing issue as argument" $ do
|
||||
it "from issue with RFC" $
|
||||
checkName Nothing "117" "117-hit-go-for-branch-switching"
|
||||
it "from issue with dots and symbols" $
|
||||
checkName Nothing "163" "163-Add-tests-commit-msgs-and"
|
||||
it "from issue with preserved special symbols" $
|
||||
checkName Nothing "175" "175-Update-header_information/-in-the-library"
|
||||
where
|
||||
checkName :: Maybe IssueNumber -> Text -> Text -> Expectation
|
||||
checkName mIssue title expectedName =
|
||||
|
32
test/Test/Hit/Parse.hs
Normal file
32
test/Test/Hit/Parse.hs
Normal file
@ -0,0 +1,32 @@
|
||||
module Test.Hit.Parse
|
||||
( parseSpec
|
||||
) where
|
||||
|
||||
import Test.Hspec (Spec, describe, it, shouldBe)
|
||||
|
||||
import Hit.Core (Owner (..), Repo (..))
|
||||
import Hit.GitHub.Auth (parseOwnerRepo)
|
||||
|
||||
|
||||
parseSpec :: Spec
|
||||
parseSpec = describe "parseOwnerRepo" $ do
|
||||
let expectedOwnerName = Owner "kowainik"
|
||||
let expectedRepoName = Repo "hit-on"
|
||||
let expectedCredentials = Just (expectedOwnerName, expectedRepoName)
|
||||
|
||||
it "Parses a GitHub repo link (SSH) and gives use the Owner Name and Repo Name separately" $ do
|
||||
parseOwnerRepo "git@github.com:kowainik/hit-on.git" `shouldBe` expectedCredentials
|
||||
it "Parses a GitHub repo link (SSH) and gives use the Owner Name and Repo Name separately" $ do
|
||||
parseOwnerRepo "git@github.com:kowainik/hit-on" `shouldBe` expectedCredentials
|
||||
it "Parses a GitHub repo link (HTTPS) and gives use the Owner Name and Repo Name separately" $ do
|
||||
parseOwnerRepo "https://github.com/kowainik/hit-on.git" `shouldBe` expectedCredentials
|
||||
it "Parses a GitHub repo link (HTTPS) and gives use the Owner Name and Repo Name separately" $ do
|
||||
parseOwnerRepo "https://github.com/kowainik/hit-on" `shouldBe` expectedCredentials
|
||||
it "Parses an invalid GitHub repo link and returns a `Nothing`" $ do
|
||||
parseOwnerRepo "github.com/kowainik/hit-on" `shouldBe` Nothing
|
||||
it "Parses an invalid GitHub repo link and returns a `Nothing`" $ do
|
||||
parseOwnerRepo "https://githu.com/kowainik/hit-on" `shouldBe` Nothing
|
||||
it "Parses an invalid GitHub repo link and returns a `Nothing`" $ 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