Create tests for all GitHub API functions

cabal.project

@@ -3,4 +3,4 @@ packages: .
 source-repository-package
     type: git
     location: git@github.com:kowainik/github-graphql.git
-    tag: fad9692bce2795643f4ef4bb0a7052ca43d07719
+    tag: bda3e6baceb1bdfd156afa851fc1d6f5e653771b

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

src/Hit/Core.hs

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

src/Hit/Error.hs

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

src/Hit/Git/Branch.hs

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

src/Hit/Git/Milestones.hs

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

src/Hit/Git/Pr.hs

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

src/Hit/GitHub/Auth.hs

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

src/Hit/GitHub/Issue.hs

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

src/Hit/GitHub/Milestone.hs

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

src/Hit/GitHub/PullRequest.hs

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

src/Hit/GitHub/User.hs

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

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

test/Spec.hs

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

test/Test/Hit/Data.hs

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

test/Test/Hit/GitHub.hs

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

test/Test/Hit/GitHub/Issue.hs

@@ -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
+        }
+    ]

test/Test/Hit/GitHub/Milestone.hs

@@ -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
+        }
+    ]

test/Test/Hit/GitHub/PullRequest.hs

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

test/Test/Hit/GitHub/User.hs

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

test/Test/Hit/Names.hs

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

test/Test/Hit/Parse.hs

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