fix the PullRequest object so it can parse

github.cabal

@@ -34,7 +34,11 @@ extra-source-files:
   fixtures/list-teams.json,
   fixtures/members-list.json,
   fixtures/user-organizations.json,
-  fixtures/user.json
+  fixtures/user.json,
+  fixtures/pull-request-realworld.json,
+  fixtures/pull-request-baxterthehacker.json,
+  fixtures/pull-request-event-github-example.json,
+  fixtures/pull-request-event-realworld.json
 
 flag aeson-compat
   description: Whether to use aeson-compat or aeson-extra
@@ -188,9 +192,11 @@ test-suite github-test
                  vector,
                  unordered-containers,
                  file-embed,
+                 aeson,
+                 text,
+                 bytestring,
                  hspec
   if flag(aeson-compat)
     build-depends: aeson-compat
   else
     build-depends: aeson-extra
-

spec/GitHub/PullRequestsSpec.hs

@@ -1,16 +1,24 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell   #-}
 module GitHub.PullRequestsSpec where
 
 import qualified GitHub
 
 import Prelude ()
 import Prelude.Compat
 
+import Data.Aeson.Compat    (eitherDecodeStrict)
 import Data.Either.Compat   (isRight)
 import Data.Foldable        (for_)
 import Data.String          (fromString)
+import qualified Data.Vector as V
 import System.Environment   (lookupEnv)
-import Test.Hspec           (Spec, describe, it, pendingWith, shouldSatisfy)
+import Data.FileEmbed       (embedFile)
+import Test.Hspec           (Spec, describe, it, pendingWith, shouldSatisfy, shouldBe)
+import GitHub.Data.Definitions (simpleUserLogin)
+import GitHub.Data.Options  (IssueState(..))
+import GitHub.Data.PullRequests
 
 fromRightS :: Show a => Either a b -> b
 fromRightS (Right b) = b
@@ -28,8 +36,34 @@ spec = do
     describe "pullRequestsForR" $ do
         it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do
             cs <- GitHub.executeRequest auth $
-                GitHub.pullRequestsForR owner repo opts GitHub.FetchAll 
+                GitHub.pullRequestsForR owner repo opts GitHub.FetchAll
             cs `shouldSatisfy` isRight
+    describe "PullRequest" $ do
+        it "can parse PR json, from a PR to the github repo" $ do
+            let pr = fromRightS $
+                  eitherDecodeStrict $(embedFile "fixtures/pull-request-realworld.json")
+
+            pullRequestState pr `shouldBe` StateOpen
+            simpleUserLogin (pullRequestUser pr) `shouldBe` "adnelson"
+            let [user] = V.toList (pullRequestAssignees pr)
+            simpleUserLogin user `shouldBe` "phadej"
+        it "can parse PR json, from the 'baxterthehacker' account" $ do
+            let pr = fromRightS $
+                  eitherDecodeStrict $(embedFile "fixtures/pull-request-baxterthehacker.json")
+            pullRequestState pr `shouldBe` StateClosed
+            simpleUserLogin (pullRequestUser pr) `shouldBe` "baxterthehacker"
+    describe "PullRequestEvent" $ do
+        it "can parse PR event json, example from github docs" $ do
+            let pre = fromRightS $
+                  eitherDecodeStrict $(embedFile "fixtures/pull-request-event-github-example.json")
+            pullRequestEventAction pre `shouldBe` PullRequestOpened
+            simpleUserLogin (pullRequestSender pre) `shouldBe` "baxterthehacker"
+        it "can parse PR event json, example from a real-world github repo" $ do
+            let pre = fromRightS $
+                  eitherDecodeStrict $(embedFile "fixtures/pull-request-event-realworld.json")
+            pullRequestEventAction pre `shouldBe` PullRequestOpened
+            simpleUserLogin (pullRequestSender pre) `shouldBe` "adnelson"
+
   where
     repos =
       [ ("thoughtbot", "paperclip")

src/GitHub/Data/PullRequests.hs

@@ -24,6 +24,9 @@ import GitHub.Data.Repos       (Repo)
 import GitHub.Data.Request     (StatusMap)
 import GitHub.Data.URL         (URL)
 import GitHub.Internal.Prelude
+import Data.Vector as V (elem, snoc)
+import Data.Aeson.Types (Parser)
+import qualified Data.Text as T
 import Prelude ()
 
 import qualified Data.Text as T
@@ -38,7 +41,7 @@ data SimplePullRequest = SimplePullRequest
     , simplePullRequestHtmlUrl   :: !URL
     , simplePullRequestUpdatedAt :: !UTCTime
     , simplePullRequestBody      :: !(Maybe Text)
-    , simplePullRequestAssignees :: (Vector SimpleUser)
+    , simplePullRequestAssignees :: !(Vector SimpleUser)
     , simplePullRequestIssueUrl  :: !URL
     , simplePullRequestDiffUrl   :: !URL
     , simplePullRequestUrl       :: !URL
@@ -62,7 +65,7 @@ data PullRequest = PullRequest
     , pullRequestHtmlUrl        :: !URL
     , pullRequestUpdatedAt      :: !UTCTime
     , pullRequestBody           :: !(Maybe Text)
-    , pullRequestAssignees      :: (Vector SimpleUser)
+    , pullRequestAssignees      :: !(Vector SimpleUser)
     , pullRequestIssueUrl       :: !URL
     , pullRequestDiffUrl        :: !URL
     , pullRequestUrl            :: !URL
@@ -76,7 +79,6 @@ data PullRequest = PullRequest
     , pullRequestComments       :: !Count
     , pullRequestDeletions      :: !Count
     , pullRequestAdditions      :: !Count
-    , pullRequestReviewComments :: !Count
     , pullRequestBase           :: !PullRequestCommit
     , pullRequestCommits        :: !Count
     , pullRequestMerged         :: !Bool
@@ -185,8 +187,22 @@ instance Binary PullRequestReference
 -- JSON instances
 -------------------------------------------------------------------------------
 
+-- | Helper function, reads either the "assignee" OR "assignees" OR
+-- both from a JSON object.
+getAssignees :: Object -> Parser (Vector SimpleUser)
+getAssignees o = do
+    assignees <- o .:? "assignees" .!= mempty
+    maybeAssignee <- o .:? "assignee"
+    pure $ case maybeAssignee of
+        Nothing -> assignees
+        Just assignee | assignee `V.elem` assignees -> assignees
+                      | otherwise -> assignees `V.snoc` assignee
+
 instance FromJSON SimplePullRequest where
-    parseJSON = withObject "SimplePullRequest" $ \o -> SimplePullRequest
+    parseJSON = withObject "SimplePullRequest" $ \o -> do
+      -- | Either key, or both, might be present, and might contain
+      -- redundant information. Take both keys and uniquify the list.
+      SimplePullRequest
         <$> o .:? "closed_at"
         <*> o .: "created_at"
         <*> o .: "user"
@@ -196,7 +212,7 @@ instance FromJSON SimplePullRequest where
         <*> o .: "html_url"
         <*> o .: "updated_at"
         <*> o .:? "body"
-        <*> o .: "assignees"
+        <*> getAssignees o
         <*> o .: "issue_url"
         <*> o .: "diff_url"
         <*> o .: "url"
@@ -236,7 +252,7 @@ instance FromJSON PullRequest where
         <*> o .: "html_url"
         <*> o .: "updated_at"
         <*> o .:? "body"
-        <*> o .: "assignees"
+        <*> getAssignees o
         <*> o .: "issue_url"
         <*> o .: "diff_url"
         <*> o .: "url"
@@ -250,7 +266,6 @@ instance FromJSON PullRequest where
         <*> o .: "comments"
         <*> o .: "deletions"
         <*> o .: "additions"
-        <*> o .: "review_comments"
         <*> o .: "base"
         <*> o .: "commits"
         <*> o .: "merged"