module GitHub.Data.PullRequests where
import Prelude ()
import Prelude.Compat
import GitHub.Data.Definitions
import GitHub.Data.Repos (Repo)
import Control.DeepSeq (NFData (..))
import Control.DeepSeq.Generics (genericRnf)
import Data.Aeson.Compat (FromJSON (..), ToJSON (..), Value (..), object,
withObject, (.:), (.:?), (.=))
import Data.Aeson.Types (Object, Parser)
import Data.Binary.Orphans (Binary)
import Data.Data (Data, Typeable)
import Data.Text (Text)
import Data.Time (UTCTime)
import GHC.Generics (Generic)
data SimplePullRequest = SimplePullRequest {
simplePullRequestClosedAt :: !(Maybe UTCTime)
,simplePullRequestCreatedAt :: !UTCTime
,simplePullRequestUser :: !SimpleUser
,simplePullRequestPatchUrl :: !Text
,simplePullRequestState :: !Text
,simplePullRequestNumber :: !Int
,simplePullRequestHtmlUrl :: !Text
,simplePullRequestUpdatedAt :: !UTCTime
,simplePullRequestBody :: !Text
,simplePullRequestIssueUrl :: !Text
,simplePullRequestDiffUrl :: !Text
,simplePullRequestUrl :: !Text
,simplePullRequestLinks :: !PullRequestLinks
,simplePullRequestMergedAt :: !(Maybe UTCTime)
,simplePullRequestTitle :: !Text
,simplePullRequestId :: !Int
} deriving (Show, Data, Typeable, Eq, Ord, Generic)
instance NFData SimplePullRequest where rnf = genericRnf
instance Binary SimplePullRequest
data PullRequest = PullRequest {
pullRequestClosedAt :: !(Maybe UTCTime)
,pullRequestCreatedAt :: !UTCTime
,pullRequestUser :: !SimpleUser
,pullRequestPatchUrl :: !Text
,pullRequestState :: !Text
,pullRequestNumber :: !Int
,pullRequestHtmlUrl :: !Text
,pullRequestUpdatedAt :: !UTCTime
,pullRequestBody :: !Text
,pullRequestIssueUrl :: !Text
,pullRequestDiffUrl :: !Text
,pullRequestUrl :: !Text
,pullRequestLinks :: !PullRequestLinks
,pullRequestMergedAt :: !(Maybe UTCTime)
,pullRequestTitle :: !Text
,pullRequestId :: !Int
,pullRequestMergedBy :: !(Maybe SimpleUser)
,pullRequestChangedFiles :: !Int
,pullRequestHead :: !PullRequestCommit
,pullRequestComments :: !Int
,pullRequestDeletions :: !Int
,pullRequestAdditions :: !Int
,pullRequestReviewComments :: !Int
,pullRequestBase :: !PullRequestCommit
,pullRequestCommits :: !Int
,pullRequestMerged :: !Bool
,pullRequestMergeable :: !(Maybe Bool)
} deriving (Show, Data, Typeable, Eq, Ord, Generic)
instance NFData PullRequest where rnf = genericRnf
instance Binary PullRequest
data EditPullRequest = EditPullRequest {
editPullRequestTitle :: !(Maybe Text)
,editPullRequestBody :: !(Maybe Text)
,editPullRequestState :: !(Maybe EditPullRequestState)
} deriving (Show, Generic)
instance NFData EditPullRequest where rnf = genericRnf
instance Binary EditPullRequest
data CreatePullRequest =
CreatePullRequest
{ createPullRequestTitle :: !Text
, createPullRequestBody :: !Text
, createPullRequestHead :: !Text
, createPullRequestBase :: !Text
}
| CreatePullRequestIssue
{ createPullRequestIssueNum :: !Int
, createPullRequestHead :: !Text
, createPullRequestBase :: !Text
}
deriving (Show, Generic)
instance NFData CreatePullRequest where rnf = genericRnf
instance Binary CreatePullRequest
data PullRequestLinks = PullRequestLinks {
pullRequestLinksReviewComments :: !Text
,pullRequestLinksComments :: !Text
,pullRequestLinksHtml :: !Text
,pullRequestLinksSelf :: !Text
} deriving (Show, Data, Typeable, Eq, Ord, Generic)
instance NFData PullRequestLinks where rnf = genericRnf
instance Binary PullRequestLinks
data PullRequestCommit = PullRequestCommit {
pullRequestCommitLabel :: !Text
,pullRequestCommitRef :: !Text
,pullRequestCommitSha :: !Text
,pullRequestCommitUser :: !SimpleUser
,pullRequestCommitRepo :: !Repo
} deriving (Show, Data, Typeable, Eq, Ord, Generic)
instance NFData PullRequestCommit where rnf = genericRnf
instance Binary PullRequestCommit
data PullRequestEvent = PullRequestEvent {
pullRequestEventAction :: !PullRequestEventType
,pullRequestEventNumber :: !Int
,pullRequestEventPullRequest :: !PullRequest
,pullRequestRepository :: !Repo
,pullRequestSender :: !SimpleUser
} deriving (Show, Data, Typeable, Eq, Ord, Generic)
instance NFData PullRequestEvent where rnf = genericRnf
instance Binary PullRequestEvent
data PullRequestEventType =
PullRequestOpened
| PullRequestClosed
| PullRequestSynchronized
| PullRequestReopened
| PullRequestAssigned
| PullRequestUnassigned
| PullRequestLabeled
| PullRequestUnlabeled
deriving (Show, Data, Typeable, Eq, Ord, Generic)
instance NFData PullRequestEventType where rnf = genericRnf
instance Binary PullRequestEventType
data PullRequestReference = PullRequestReference {
pullRequestReferenceHtmlUrl :: !(Maybe Text)
,pullRequestReferencePatchUrl :: !(Maybe Text)
,pullRequestReferenceDiffUrl :: !(Maybe Text)
} deriving (Show, Data, Typeable, Eq, Ord, Generic)
instance NFData PullRequestReference where rnf = genericRnf
instance Binary PullRequestReference
data EditPullRequestState =
EditPullRequestStateOpen
| EditPullRequestStateClosed
deriving (Show, Generic)
instance NFData EditPullRequestState where rnf = genericRnf
instance Binary EditPullRequestState
instance FromJSON SimplePullRequest where
parseJSON = withObject "SimplePullRequest" $ \o ->
SimplePullRequest
<$> o .:? "closed_at"
<*> o .: "created_at"
<*> o .: "user"
<*> o .: "patch_url"
<*> o .: "state"
<*> o .: "number"
<*> o .: "html_url"
<*> o .: "updated_at"
<*> o .: "body"
<*> o .: "issue_url"
<*> o .: "diff_url"
<*> o .: "url"
<*> o .: "_links"
<*> o .:? "merged_at"
<*> o .: "title"
<*> o .: "id"
instance ToJSON EditPullRequestState where
toJSON (EditPullRequestStateOpen) = String "open"
toJSON (EditPullRequestStateClosed) = String "closed"
instance ToJSON EditPullRequest where
toJSON (EditPullRequest t b s) =
object $ filter notNull [ "title" .= t, "body" .= b, "state" .= s ]
where notNull (_, Null) = False
notNull (_, _) = True
instance ToJSON CreatePullRequest where
toJSON (CreatePullRequest t b headPR basePR) =
object [ "title" .= t, "body" .= b, "head" .= headPR, "base" .= basePR ]
toJSON (CreatePullRequestIssue issueNum headPR basePR) =
object [ "issue" .= issueNum, "head" .= headPR, "base" .= basePR]
instance FromJSON PullRequest where
parseJSON = withObject "PullRequest" $ \o ->
PullRequest
<$> o .:? "closed_at"
<*> o .: "created_at"
<*> o .: "user"
<*> o .: "patch_url"
<*> o .: "state"
<*> o .: "number"
<*> o .: "html_url"
<*> o .: "updated_at"
<*> o .: "body"
<*> o .: "issue_url"
<*> o .: "diff_url"
<*> o .: "url"
<*> o .: "_links"
<*> o .:? "merged_at"
<*> o .: "title"
<*> o .: "id"
<*> o .:? "merged_by"
<*> o .: "changed_files"
<*> o .: "head"
<*> o .: "comments"
<*> o .: "deletions"
<*> o .: "additions"
<*> o .: "review_comments"
<*> o .: "base"
<*> o .: "commits"
<*> o .: "merged"
<*> o .:? "mergeable"
instance FromJSON PullRequestLinks where
parseJSON = withObject "PullRequestLinks" $ \o ->
PullRequestLinks <$> o <.:> ["review_comments", "href"]
<*> o <.:> ["comments", "href"]
<*> o <.:> ["html", "href"]
<*> o <.:> ["self", "href"]
instance FromJSON PullRequestCommit where
parseJSON = withObject "PullRequestCommit" $ \o ->
PullRequestCommit <$> o .: "label"
<*> o .: "ref"
<*> o .: "sha"
<*> o .: "user"
<*> o .: "repo"
instance FromJSON PullRequestEvent where
parseJSON = withObject "PullRequestEvent" $ \o ->
PullRequestEvent <$> o .: "action"
<*> o .: "number"
<*> o .: "pull_request"
<*> o .: "repository"
<*> o .: "sender"
instance FromJSON PullRequestEventType where
parseJSON (String "opened") = pure PullRequestOpened
parseJSON (String "closed") = pure PullRequestClosed
parseJSON (String "synchronize") = pure PullRequestSynchronized
parseJSON (String "reopened") = pure PullRequestReopened
parseJSON (String "assigned") = pure PullRequestAssigned
parseJSON (String "unassigned") = pure PullRequestUnassigned
parseJSON (String "labeled") = pure PullRequestLabeled
parseJSON (String "unlabeled") = pure PullRequestUnlabeled
parseJSON _ = fail "Could not build a PullRequestEventType"
instance FromJSON PullRequestReference where
parseJSON = withObject "PullRequestReference" $ \o ->
PullRequestReference <$> o .:? "html_url"
<*> o .:? "patch_url"
<*> o .:? "diff_url"
(<.:>) :: FromJSON v => Object -> [Text] -> Parser v
obj <.:> [key] = obj .: key
obj <.:> (key:keys) = do
obj' <- obj .: key
obj' <.:> keys
_obj <.:> [] = fail "<.:> never happens - empty path"