Merge pull request haskell-github#36 from ian-ross/create-issues

jwiegley · jwiegley · commit cb65642df409 · 2013-07-30T18:28:27.000-07:00
Create and edit issues and comments
diff --git a/Github/Data.hs b/Github/Data.hs
@@ -122,6 +122,12 @@ instance FromJSON Comment where
             <*> o .: "id"
   parseJSON _          = fail "Could not build a Comment"
 
+instance ToJSON NewComment where
+  toJSON (NewComment b) = object [ "body" .= b ]
+
+instance ToJSON EditComment where
+  toJSON (EditComment b) = object [ "body" .= b ]
+
 instance FromJSON Diff where
   parseJSON (Object o) =
     Diff <$> o .: "status"
@@ -218,6 +224,26 @@ instance FromJSON Issue where
           <*> o .:? "milestone"
   parseJSON _          = fail "Could not build an Issue"
 
+instance ToJSON NewIssue where
+  toJSON (NewIssue t b a m ls) =
+    object
+    [ "title"     .= t
+    , "body"      .= b
+    , "assignee"  .= a
+    , "milestone" .= m
+    , "labels"    .= ls ]
+
+instance ToJSON EditIssue where
+  toJSON (EditIssue t b a s m ls) =
+    object $ filter notNull $ [ "title" .= t
+                              , "body" .= b
+                              , "assignee" .= a
+                              , "state" .= s
+                              , "milestone" .= m
+                              , "labels" .= ls ]
+    where notNull (_, Null) = False
+          notNull (_, _)    = True
+
 instance FromJSON Milestone where
   parseJSON (Object o) =
     Milestone <$> o .: "creator"
diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs
@@ -107,6 +107,14 @@ data Comment = Comment {
   ,commentId :: Int
 } deriving (Show, Data, Typeable, Eq, Ord)
 
+data NewComment = NewComment {
+   newCommentBody :: String
+} deriving (Show, Data, Typeable, Eq, Ord)
+
+data EditComment = EditComment {
+   editCommentBody :: String
+} deriving (Show, Data, Typeable, Eq, Ord)
+
 data Diff = Diff {
    diffStatus :: String
   ,diffBehindBy :: Int
@@ -195,6 +203,24 @@ data Issue = Issue {
   ,issueMilestone :: Maybe Milestone
 } deriving (Show, Data, Typeable, Eq, Ord)
 
+data NewIssue = NewIssue {
+  newIssueTitle :: String
+, newIssueBody :: Maybe String
+, newIssueAssignee :: Maybe String
+, newIssueMilestone :: Maybe Int
+, newIssueLabels :: Maybe [String]
+} deriving (Show, Data, Typeable, Eq, Ord)
+
+data EditIssue = EditIssue {
+  editIssueTitle :: Maybe String
+, editIssueBody :: Maybe String
+, editIssueAssignee :: Maybe String
+, editIssueState :: Maybe String
+, editIssueMilestone :: Maybe Int
+, editIssueLabels :: Maybe [String]
+} deriving  (Show, Data, Typeable, Eq, Ord)
+
+
 data Milestone = Milestone {
    milestoneCreator :: GithubOwner
   ,milestoneDueOn :: Maybe GithubDate
diff --git a/Github/Issues.hs b/Github/Issues.hs
@@ -1,15 +1,28 @@
+{-# LANGUAGE OverloadedStrings #-}
 -- | The issues API as described on <http://developer.github.com/v3/issues/>.
 module Github.Issues (
  issue
 ,issue'
 ,issuesForRepo
 ,issuesForRepo'
 ,IssueLimitation(..)
+
+-- * Modifying Issues
+-- |
+-- Only authenticated users may create and edit issues.
+,GithubAuth(..)
+
+,createIssue
+,newIssue
+,editIssue
+,editOfIssue
 ,module Github.Data
 ) where
 
 import Github.Data
 import Github.Private
+import Data.Aeson.Types
+import qualified Data.Aeson as A
 import Data.List (intercalate)
 import Data.Time.Format (formatTime)
 import System.Locale (defaultTimeLocale)
@@ -84,3 +97,36 @@ issuesForRepo' auth user repoName issueLimitations =
 -- > issuesForRepo "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending]
 issuesForRepo :: String -> String -> [IssueLimitation] -> IO (Either Error [Issue])
 issuesForRepo = issuesForRepo' Nothing
+
+
+-- Creating new issues.
+
+newIssue :: String -> NewIssue
+newIssue title = NewIssue title Nothing Nothing Nothing Nothing
+
+
+-- |
+-- Create a new issue.
+--
+-- > createIssue (GithubUser (user, password)) user repo
+-- >  (newIssue "some_repo") {...}
+createIssue :: GithubAuth -> String -> String -> NewIssue
+            -> IO (Either Error Issue)
+createIssue auth user repo = githubPost auth ["repos", user, repo, "issues"]
+
+
+-- Editing issues.
+
+editOfIssue :: EditIssue
+editOfIssue = EditIssue Nothing Nothing Nothing Nothing Nothing Nothing
+
+
+-- |
+-- Edit an issue.
+--
+-- > editIssue (GithubUser (user, password)) user repo issue
+-- >  editOfIssue {...}
+editIssue :: GithubAuth -> String -> String -> Int -> EditIssue
+            -> IO (Either Error Issue)
+editIssue auth user repo iss =
+  githubPatch auth ["repos", user, repo, "issues", show iss]
diff --git a/Github/Issues/Comments.hs b/Github/Issues/Comments.hs
@@ -4,6 +4,14 @@ module Github.Issues.Comments (
  comment
 ,comments
 ,comments'
+
+-- * Modifying Comments
+-- |
+-- Only authenticated users may create and edit comments.
+,GithubAuth(..)
+
+,createComment
+,editComment
 ,module Github.Data
 ) where
 
@@ -31,3 +39,27 @@ comments' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error [Is
 comments' auth user repoName issueNumber =
   githubGet' auth ["repos", user, repoName, "issues", show issueNumber, "comments"]
 
+
+
+-- |
+-- Create a new comment.
+--
+-- > createComment (GithubUser (user, password)) user repo issue
+-- >  "some words"
+createComment :: GithubAuth -> String -> String -> Int -> String
+            -> IO (Either Error Comment)
+createComment auth user repo iss body =
+  githubPost auth
+  ["repos", user, repo, "issues", show iss, "comments"] (NewComment body)
+
+
+-- |
+-- Edit a comment.
+--
+-- > editComment (GithubUser (user, password)) user repo commentid
+-- >  "new words"
+editComment :: GithubAuth -> String -> String -> Int -> String
+            -> IO (Either Error Comment)
+editComment auth user repo commid body =
+  githubPatch auth ["repos", user, repo, "issues", "comments", show commid]
+  (EditComment body)
diff --git a/samples/Issues/CreateIssue.hs b/samples/Issues/CreateIssue.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE OverloadedStrings #-}
+module CreateIssue where
+
+import qualified Github.Issues as Github
+
+main = do
+  let auth = Github.GithubBasicAuth "user" "password"
+      newiss = (Github.newIssue "A new issue") {
+        Github.newIssueBody = Just "Issue description text goes here"
+        }
+  possibleIssue <- Github.createIssue auth "thoughtbot" "paperclip" newiss
+  putStrLn $ either (\e -> "Error: " ++ show e)
+                    formatIssue
+                    possibleIssue
+
+formatIssue issue =
+  (Github.githubOwnerLogin $ Github.issueUser issue) ++
+    " opened this issue " ++
+    (show $ Github.fromGithubDate $ Github.issueCreatedAt issue) ++ "\n" ++
+    (Github.issueState issue) ++ " with " ++
+    (show $ Github.issueComments issue) ++ " comments" ++ "\n\n" ++
+    (Github.issueTitle issue)
diff --git a/samples/Issues/EditIssue.hs b/samples/Issues/EditIssue.hs
@@ -0,0 +1,21 @@
+{-# LANGUAGE OverloadedStrings #-}
+module EditIssue where
+
+import qualified Github.Issues as Github
+
+main = do
+  let auth = Github.GithubBasicAuth "user" "password"
+      issueid = 3
+      edit = Github.editOfIssue { Github.editIssueState = Just "closed" }
+  possibleIssue <- Github.editIssue auth "thoughtbot" "paperclip" issueid edit
+  putStrLn $ either (\e -> "Error: " ++ show e)
+                    formatIssue
+                    possibleIssue
+
+formatIssue issue =
+  (Github.githubOwnerLogin $ Github.issueUser issue) ++
+    " opened this issue " ++
+    (show $ Github.fromGithubDate $ Github.issueCreatedAt issue) ++ "\n" ++
+    (Github.issueState issue) ++ " with " ++
+    (show $ Github.issueComments issue) ++ " comments" ++ "\n\n" ++
+    (Github.issueTitle issue)
