[#214] New Issue and Milestone additions

src/Hit/Error.hs

@@ -23,4 +23,4 @@ renderHitError = \case
     NoGitHubTokenEnv ->
         "The environment variable GITHUB_TOKEN is not set"
     InvalidOwnerRepo ->
-        "Cannot not parse the 'owner' and 'repo' names from the owner/repo format"
+        "Can't parse the 'owner' and 'repo' names from the 'owner/repo' format"

src/Hit/Git/Issue.hs

@@ -239,13 +239,3 @@ fetchCurrentMilestoneId = withOwnerRepo milestones' >>= \case
     Right ms -> case sortWith Down $ map milestoneNumber $ toList ms of
         []  -> warningMessage "There are no open milestones for this project" >> pure Nothing
         m:_ -> pure $ Just m
-
--- | Create new issue with title and assignee.
-mkNewIssue :: Text -> Text -> Maybe (Id G.Milestone) -> NewIssue
-mkNewIssue title login milestone = NewIssue
-    { newIssueTitle     = title
-    , newIssueBody      = Nothing
-    , newIssueAssignees = V.singleton $ makeName @User login
-    , newIssueMilestone = milestone
-    , newIssueLabels    = Nothing
-    }

src/Hit/GitHub/Issue.hs

@@ -16,17 +16,18 @@ module Hit.GitHub.Issue
     , ShortIssue (..)
     , queryIssueList
     , issueToShort
+
+    , IssueNumber (..)
+    , mutationCreateNewIssue
     ) where
 
 import Data.Aeson (Array, FromJSON (..), withObject, (.:))
 import Data.Aeson.Types (Parser)
 import Prolens (set)
 
 import Hit.Core (IssueOptions (..), Milestone (..), Owner (..), Repo (..))
-import Hit.Error (renderHitError)
 import Hit.Git.Common (getUsername)
-import Hit.GitHub.RepositoryNode (RepositoryNode (..))
-import Hit.Prompt (arrow)
+import Hit.GitHub.Repository (RepositoryField (..), RepositoryNode (..))
 
 import qualified Hit.Formatting as Fmt
 
@@ -53,22 +54,19 @@ data Issue = Issue
 instance FromJSON Issue
   where
     parseJSON = withObject "Issue" $ \o -> do
-        repository <- o .: "repository"
-        i <- repository .: "issue"
-
-        issueTitle       <- i .: "title"
-        author           <- i .: "author"
+        issueTitle       <- o .: "title"
+        author           <- o .: "author"
         issueAuthorLogin <- author .: "login"
-        issueBody        <- i .: "body"
-        issueNumber      <- i .: "number"
-        issueUrl         <- i .: "url"
-        issueState       <- i .: "state"
+        issueBody        <- o .: "body"
+        issueNumber      <- o .: "number"
+        issueUrl         <- o .: "url"
+        issueState       <- o .: "state"
 
-        labels           <- i .: "labels"
+        labels           <- o .: "labels"
         labelNodes       <- labels .: "nodes"
         issueLabels      <- parseLabels labelNodes
 
-        assignees        <- i .: "assignees"
+        assignees        <- o .: "assignees"
         assigneesNodes   <- assignees .: "nodes"
         issueAssignees   <- parseAssignees assigneesNodes
 
@@ -122,9 +120,12 @@ issueQuery (Owner owner) (Repo repo) issueNumber = GH.repository
 {- | Queries a single issue by number.
 -}
 queryIssue :: GH.GitHubToken -> Owner -> Repo -> Int -> IO Issue
-queryIssue token owner repo issueNumber = GH.queryGitHub
-    token
-    (GH.repositoryToAst $ issueQuery owner repo issueNumber)
+queryIssue token owner repo issueNumber =
+    unRepositoryField <$>
+    GH.queryGitHub
+        @(RepositoryField "issue" Issue)
+        token
+        (GH.repositoryToAst $ issueQuery owner repo issueNumber)
 
 ----------------------------------------------------------------------------
 -- Small issue type
@@ -203,6 +204,56 @@ queryIssueList token owner repo =
         token
         (GH.repositoryToAst $ issueListQuery owner repo)
 
+----------------------------------------------------------------------------
+-- Create new issue
+----------------------------------------------------------------------------
+
+{- | Data type to parse only issue number.
+-}
+newtype IssueNumber = IssueNumber
+    { unIssueNumber :: Int
+    }
+
+instance FromJSON IssueNumber
+  where
+    parseJSON = withObject "IssueNumber" $ \o ->
+        IssueNumber <$> (o .: "number")
+
+{- | Query to create issue and return its number.
+-}
+createIssueMutation
+    :: GH.RepositoryId
+    -> Text  -- ^ Issue title
+    -> Maybe GH.MilestoneId
+    -> GH.CreateIssue
+createIssueMutation repoId issueTitle milestoneId = GH.CreateIssue
+    ( GH.defCreateIssueInput
+    & set GH.repositoryIdL repoId
+    & set GH.titleL issueTitle
+    & setMilestone
+    )
+    [ GH.IssueNumber
+    ]
+  where
+    setMilestone :: GH.CreateIssueInput fields -> GH.CreateIssueInput fields
+    setMilestone = case milestoneId of
+        Nothing  -> id
+        Just mId -> set GH.milestoneIdL mId
+
+mutationCreateNewIssue
+    :: GH.GitHubToken
+    -> Owner
+    -> Repo
+    -> Text
+    -> Maybe Milestone
+    -> IO IssueNumber
+mutationCreateNewIssue token owner repo issueTitle _mMilestone = do
+    repositoryId <- GH.queryRepositoryId token owner repo
+    unRepositoryField <$>
+    GH.mutationGitHub
+        token
+        (GH.createIssueToAst $ createIssueMutation repositoryId issueTitle Nothing)
+
 ----------------------------------------------------------------------------
 -- Internals
 ----------------------------------------------------------------------------

src/Hit/GitHub/Milestone.hs

@@ -16,6 +16,7 @@ module Hit.GitHub.Milestone
 import Prolens (set)
 
 import Hit.Core (Owner (..), Repo (..))
+import Hit.GitHub.Repository (RepositoryNodes (..))
 
 import qualified GitHub as GH
 
@@ -72,3 +73,13 @@ milestonesQuery (Owner owner) (Repo repo) = GH.repository
                (one GH.TotalCount)
            ]
         )
+
+{- | Queries the latest 100 issues of the repository.
+-}
+queryMilestoneList :: GH.GitHubToken -> Owner -> Repo -> IO [Milestone]
+queryMilestoneList token owner repo =
+    unRepositoryNodes <$>
+    GH.queryGitHub
+        @(RepositoryNodes "milestones" Milestone)
+        token
+        (GH.repositoryToAst $ milestonesQuery owner repo)

src/Hit/GitHub/Repository.hs

@@ -10,7 +10,8 @@ Repository-related queries and data types.
 -}
 
 module Hit.GitHub.Repository
-    ( RepositoryNodes (..)
+    ( RepositoryField (..)
+    , RepositoryNodes (..)
     ) where
 
 import Data.Aeson (FromJSON (..), withObject, (.:))
@@ -43,3 +44,28 @@ instance
         items <- repository .: itemName
         nodes <- items .: "nodes"
         RepositoryNode <$> mapM parseJSON nodes
+
+{- | Helper type to parse a given field of the top-level @repository@ query.
+
+The JSON usually has the following shape:
+
+@
+{
+  "data": {
+    "repository": {
+      "<name>": {
+            ...
+@
+-}
+newtype RepositoryField (name :: Symbol) a = RepositoryField
+    { unRepositoryField :: [a]
+    }
+
+instance
+    (KnownSymbol name, FromJSON a, Typeable a)
+    => FromJSON (RepositoryField name a)
+  where
+    parseJSON = withObject ("RepositoryField " <> typeName @a) $ \o -> do
+        repository <- o .: "repository"
+        let fieldName = symbolVal (Proxy @name)
+        RepositoryField <$> (repository .: fieldName)