Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

WIP: Add initial ToJSON #15

Closed
wants to merge 2 commits into from
Closed

WIP: Add initial ToJSON #15

Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
3e001d3
WIP: Add initial ToJSON
Apr 20, 2018
d8b871b
WIP: Add more ToJSON instances
Apr 20, 2018
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
87 changes: 86 additions & 1 deletion src/GitHub/Data/Webhooks/Payload.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -43,7 +43,7 @@ module GitHub.Data.Webhooks.Payload
, HookPullRequestReviewComment(..)
) where

import Data.Aeson (FromJSON(..), withObject, withText, (.!=), (.:), (.:?))
import Data.Aeson (FromJSON(..), ToJSON(..), Value(..), withObject, withText, object, (.!=), (.:), (.:?), (.=))
import Control.DeepSeq (NFData (..))
import Control.DeepSeq.Generics (genericRnf)
import Control.Applicative ((<|>))
Expand Down Expand Up @@ -71,6 +71,10 @@ instance FromJSON OwnerType where
"organization" -> pure OwnerOrganization
_ -> fail $ "Unknown owner type: " ++ T.unpack t

instance ToJSON OwnerType where
toJSON OwnerUser = String "user"
toJSON OwnerOrganization = String "organization"


-- | Represents an internet address that would be suitable to query
-- for more information. The GitHub API only returns valid 'URL's.
Expand All @@ -82,6 +86,9 @@ instance NFData URL where rnf = genericRnf
instance FromJSON URL where
parseJSON = withText "URL" (pure . URL)

instance ToJSON URL where
toJSON (URL url) = String url

-- | Demote GitHub URL to Text.
getUrl :: URL -> Text
getUrl (URL url) = url
Expand Down Expand Up @@ -660,6 +667,32 @@ instance FromJSON HookIssue where
<*> o .:? "closed_at"
<*> o .: "body"

instance ToJSON HookIssue where
toJSON hookIssue = object
[ "url" .= whIssueUrl hookIssue
, "labels_url" .= whIssueLabelsUrl hookIssue
, "comments_url" .= whIssueCommentsUrl hookIssue
, "events_url" .= whIssueEventsUrl hookIssue
, "html_url" .= whIssueHtmlUrl hookIssue
, "id" .= whIssueId hookIssue
, "number" .= whIssueNumber hookIssue
, "title" .= whIssueTitle hookIssue
, "user" .= whIssueUser hookIssue
, "labels" .= whIssueLabels hookIssue
, "state" .= whIssueState hookIssue
, "locked" .= whIssueIsLocked hookIssue
, "assignee" .= whIssueAssignee hookIssue
, "milestone" .= whIssueMilestone hookIssue
, "comments" .= whIssueCommentCount hookIssue
, "created_at" .= whIssueCreatedAt hookIssue
, "updated_at" .= whIssueUpdatedAt hookIssue
, "closed_at" .= (case whIssueClosedAt hookIssue of
Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Does it make sense to return an empty string if there is no value for closed_at - i.e. it is Nothing?

Instead, how about about letting it possibly be null via fmap toJSON (whIssueClosedAt hookIssue) ?

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Sounds good. I'll do that

Just utcTime -> toJSON utcTime
Nothing -> ""
)
, "body" .= whIssueBody hookIssue
]

instance FromJSON HookRepository where
parseJSON = withObject "HookRepository" $ \o -> HookRepository
<$> o .: "id"
Expand Down Expand Up @@ -760,6 +793,27 @@ instance FromJSON HookUser where
<*> o .: "type"
<*> o .: "site_admin"

instance ToJSON HookUser where
toJSON hookUser = object
[ "login" .= whUserLogin hookUser
, "id" .= whUserId hookUser
, "avatar_url" .= whUserAvatarUrl hookUser
, "gravatar_id" .= whUserGravatarId hookUser
, "url" .= whUserUrl hookUser
, "html_url" .= whUserHtmlUrl hookUser
, "followers_url" .= whUserFollowersUrl hookUser
, "following_url" .= whUserFollowingUrl hookUser
, "gists_url" .= whUserGistsUrl hookUser
, "starred_url" .= whUserStarredUrl hookUser
, "subscriptions_url" .= whUserSubscriptionsUrl hookUser
, "organizations_url" .= whUserOrganizationsUrl hookUser
, "repos_url" .= whUserReposUrl hookUser
, "events_url" .= whUserEventsUrl hookUser
, "received_events_url" .= whUserReceivedEventsUrl hookUser
, "type" .= whUserType hookUser
, "site_admin" .= whUserIsAdminOfSite hookUser
]

instance FromJSON HookSimpleUser where
parseJSON = withObject "HookSimpleUser" $ \o -> HookSimpleUser
<$> o .: "name"
Expand Down Expand Up @@ -823,6 +877,25 @@ instance FromJSON HookMilestone where
<*> o .: "due_on"
<*> o .: "closed_at"

instance ToJSON HookMilestone where
toJSON hookMilestone = object
[ "url" .= whMilestoneUrl hookMilestone
, "html_url" .= whMilestoneHtmlUrl hookMilestone
, "labels_url" .= whMilestoneLabelsUrl hookMilestone
, "id" .= whMilestoneId hookMilestone
, "number" .= whMilestoneNumber hookMilestone
, "title" .= whMilestoneTitle hookMilestone
, "description" .= whMilestoneDescription hookMilestone
, "creator" .= whMilestoneCreator hookMilestone
, "open_issues" .= whMilestoneOpenIssues hookMilestone
, "closed_issues" .= whMilestoneClosedIssues hookMilestone
, "state" .= whMilestoneState hookMilestone
, "created_at" .= whMilestoneCreatedAt hookMilestone
, "updated_at" .= whMilestoneUpdatedAt hookMilestone
, "due_on" .= whMilestoneDueOn hookMilestone
, "closed_at" .= whMilestoneClosedAt hookMilestone
]

instance FromJSON HookMembership where
parseJSON = withObject "HookMembership" $ \o -> HookMembership
<$> o .: "url"
Expand Down Expand Up @@ -875,6 +948,18 @@ instance FromJSON HookIssueLabels where
<*> o .: "color"
<*> o .:? "default" .!= False

instance ToJSON HookIssueLabels where
toJSON hookIssueLabels = object
[ "id" .= (case whIssueLabelId hookIssueLabels of
Just hookIssueLabelsId -> toJSON hookIssueLabelsId
Nothing -> ""
)
, "url" .= whIssueLabelUrl hookIssueLabels
, "name" .= whIssueLabelName hookIssueLabels
, "color" .= whIssueLabelColor hookIssueLabels
, "default" .= whIssueLabelIsDefault hookIssueLabels
]

instance FromJSON HookCommit where
parseJSON = withObject "HookCommit" $ \o -> HookCommit
<$> (o .: "sha" <|> o .: "id")
Expand Down