module Github.Data (module Github.Data.Definitions) where
import Data.Time
import Control.Applicative
import Control.Monad
import qualified Data.Text as T
import Data.Aeson.Types
import System.Locale (defaultTimeLocale)
import qualified Data.Vector as V
import qualified Data.HashMap.Lazy as Map
import Data.Hashable (Hashable)
import Github.Data.Definitions
instance FromJSON GithubDate where
parseJSON (String t) =
case parseTime defaultTimeLocale "%FT%T%Z" (T.unpack t) of
Just d -> pure $ GithubDate d
_ -> fail "could not parse Github datetime"
parseJSON _ = fail "Given something besides a String"
instance FromJSON Commit where
parseJSON (Object o) =
Commit <$> o .: "sha"
<*> o .: "parents"
<*> o .: "url"
<*> o .: "commit"
<*> o .:? "committer"
<*> o .:? "author"
<*> o .:< "files"
<*> o .:? "stats"
parseJSON _ = fail "Could not build a Commit"
instance FromJSON Tree where
parseJSON (Object o) =
Tree <$> o .: "sha"
<*> o .: "url"
<*> o .:< "tree"
parseJSON _ = fail "Could not build a Tree"
instance FromJSON GitTree where
parseJSON (Object o) =
GitTree <$> o .: "type"
<*> o .: "sha"
<*> o .:? "url"
<*> o .:? "size"
<*> o .: "path"
<*> o .: "mode"
parseJSON _ = fail "Could not build a GitTree"
instance FromJSON GitCommit where
parseJSON (Object o) =
GitCommit <$> o .: "message"
<*> o .: "url"
<*> o .: "committer"
<*> o .: "author"
<*> o .: "tree"
<*> o .:? "sha"
<*> o .:< "parents"
parseJSON _ = fail "Could not build a GitCommit"
instance FromJSON GithubOwner where
parseJSON (Object o)
| o `at` "gravatar_id" == Nothing =
GithubOrganization <$> o .: "avatar_url"
<*> o .: "login"
<*> o .: "url"
<*> o .: "id"
| otherwise =
GithubUser <$> o .: "avatar_url"
<*> o .: "login"
<*> o .: "url"
<*> o .: "id"
<*> o .: "gravatar_id"
parseJSON v = fail $ "Could not build a GithubOwner out of " ++ (show v)
instance FromJSON GitUser where
parseJSON (Object o) =
GitUser <$> o .: "name"
<*> o .: "email"
<*> o .: "date"
parseJSON _ = fail "Could not build a GitUser"
instance FromJSON File where
parseJSON (Object o) =
File <$> o .: "blob_url"
<*> o .: "status"
<*> o .: "raw_url"
<*> o .: "additions"
<*> o .: "sha"
<*> o .: "changes"
<*> o .: "patch"
<*> o .: "filename"
<*> o .: "deletions"
parseJSON _ = fail "Could not build a File"
instance FromJSON Stats where
parseJSON (Object o) =
Stats <$> o .: "additions"
<*> o .: "total"
<*> o .: "deletions"
parseJSON _ = fail "Could not build a Stats"
instance FromJSON Comment where
parseJSON (Object o) =
Comment <$> o .:? "position"
<*> o .:? "line"
<*> o .: "body"
<*> o .:? "commit_id"
<*> o .: "updated_at"
<*> o .:? "html_url"
<*> o .: "url"
<*> o .: "created_at"
<*> o .:? "path"
<*> o .: "user"
<*> 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"
<*> o .: "behind_by"
<*> o .: "patch_url"
<*> o .: "url"
<*> o .: "base_commit"
<*> o .:< "commits"
<*> o .: "total_commits"
<*> o .: "html_url"
<*> o .:< "files"
<*> o .: "ahead_by"
<*> o .: "diff_url"
<*> o .: "permalink_url"
parseJSON _ = fail "Could not build a Diff"
instance FromJSON Gist where
parseJSON (Object o) =
Gist <$> o .: "user"
<*> o .: "git_push_url"
<*> o .: "url"
<*> o .:? "description"
<*> o .: "created_at"
<*> o .: "public"
<*> o .: "comments"
<*> o .: "updated_at"
<*> o .: "html_url"
<*> o .: "id"
<*> o `values` "files"
<*> o .: "git_push_url"
parseJSON _ = fail "Could not build a Gist"
instance FromJSON GistFile where
parseJSON (Object o) =
GistFile <$> o .: "type"
<*> o .: "raw_url"
<*> o .: "size"
<*> o .:? "language"
<*> o .: "filename"
<*> o .:? "content"
parseJSON _ = fail "Could not build a GistFile"
instance FromJSON GistComment where
parseJSON (Object o) =
GistComment <$> o .: "user"
<*> o .: "url"
<*> o .: "created_at"
<*> o .: "body"
<*> o .: "updated_at"
<*> o .: "id"
parseJSON _ = fail "Could not build a GistComment"
instance FromJSON Blob where
parseJSON (Object o) =
Blob <$> o .: "url"
<*> o .: "encoding"
<*> o .: "content"
<*> o .: "sha"
<*> o .: "size"
parseJSON _ = fail "Could not build a Blob"
instance FromJSON GitReference where
parseJSON (Object o) =
GitReference <$> o .: "object"
<*> o .: "url"
<*> o .: "ref"
parseJSON _ = fail "Could not build a GitReference"
instance FromJSON GitObject where
parseJSON (Object o) =
GitObject <$> o .: "type"
<*> o .: "sha"
<*> o .: "url"
parseJSON _ = fail "Could not build a GitObject"
instance FromJSON Issue where
parseJSON (Object o) =
Issue <$> o .:? "closed_at"
<*> o .: "updated_at"
<*> o .: "events_url"
<*> o .: "html_url"
<*> o .:? "closed_by"
<*> o .: "labels"
<*> o .: "number"
<*> o .:? "assignee"
<*> o .: "user"
<*> o .: "title"
<*> o .:? "pull_request"
<*> o .: "url"
<*> o .: "created_at"
<*> o .: "body"
<*> o .: "state"
<*> o .: "id"
<*> o .: "comments"
<*> 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"
<*> o .: "due_on"
<*> o .: "open_issues"
<*> o .: "number"
<*> o .: "closed_issues"
<*> o .: "description"
<*> o .: "title"
<*> o .: "url"
<*> o .: "created_at"
<*> o .: "state"
parseJSON _ = fail "Could not build a Milestone"
instance FromJSON IssueLabel where
parseJSON (Object o) =
IssueLabel <$> o .: "color"
<*> o .: "url"
<*> o .: "name"
parseJSON _ = fail "Could not build a Milestone"
instance FromJSON PullRequestReference where
parseJSON (Object o) =
PullRequestReference <$> o .:? "html_url"
<*> o .:? "patch_url"
<*> o .:? "diff_url"
parseJSON _ = fail "Could not build a PullRequest"
instance FromJSON IssueComment where
parseJSON (Object o) =
IssueComment <$> o .: "updated_at"
<*> o .: "user"
<*> o .: "url"
<*> o .: "created_at"
<*> o .: "body"
<*> o .: "id"
parseJSON _ = fail "Could not build an IssueComment"
instance FromJSON Event where
parseJSON (Object o) =
Event <$> o .: "actor"
<*> o .: "event"
<*> o .:? "commit_id"
<*> o .: "url"
<*> o .: "created_at"
<*> o .: "id"
<*> o .:? "issue"
parseJSON _ = fail "Could not build an Event"
instance FromJSON EventType where
parseJSON (String "closed") = pure Closed
parseJSON (String "reopened") = pure Reopened
parseJSON (String "subscribed") = pure Subscribed
parseJSON (String "merged") = pure Merged
parseJSON (String "referenced") = pure Referenced
parseJSON (String "mentioned") = pure Mentioned
parseJSON (String "assigned") = pure Assigned
parseJSON (String "unsubscribed") = pure Unsubscribed
parseJSON (String "unassigned") = pure ActorUnassigned
parseJSON (String "labeled") = pure Labeled
parseJSON (String "unlabeled") = pure Unlabeled
parseJSON (String "milestoned") = pure Milestoned
parseJSON (String "demilestoned") = pure Demilestoned
parseJSON (String "renamed") = pure Renamed
parseJSON (String "locked") = pure Locked
parseJSON (String "unlocked") = pure Unlocked
parseJSON (String "head_ref_deleted") = pure HeadRefDeleted
parseJSON (String "head_ref_restored") = pure HeadRefRestored
parseJSON _ = fail "Could not build an EventType"
instance FromJSON SimpleOrganization where
parseJSON (Object o) =
SimpleOrganization <$> o .: "url"
<*> o .: "avatar_url"
<*> o .: "id"
<*> o .: "login"
parseJSON _ = fail "Could not build a SimpleOrganization"
instance FromJSON Organization where
parseJSON (Object o) =
Organization <$> o .: "type"
<*> o .:? "blog"
<*> o .:? "location"
<*> o .: "login"
<*> o .: "followers"
<*> o .:? "company"
<*> o .: "avatar_url"
<*> o .: "public_gists"
<*> o .: "html_url"
<*> o .:? "email"
<*> o .: "following"
<*> o .: "public_repos"
<*> o .: "url"
<*> o .: "created_at"
<*> o .:? "name"
<*> o .: "id"
parseJSON _ = fail "Could not build an Organization"
instance FromJSON PullRequest where
parseJSON (Object 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"
parseJSON _ = fail "Could not build a PullRequest"
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 FromJSON DetailedPullRequest where
parseJSON (Object o) =
DetailedPullRequest
<$> 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"
parseJSON _ = fail "Could not build a DetailedPullRequest"
instance FromJSON PullRequestLinks where
parseJSON (Object o) =
PullRequestLinks <$> o <.:> ["review_comments", "href"]
<*> o <.:> ["comments", "href"]
<*> o <.:> ["html", "href"]
<*> o <.:> ["self", "href"]
parseJSON _ = fail "Could not build a PullRequestLinks"
instance FromJSON PullRequestCommit where
parseJSON (Object o) =
PullRequestCommit <$> o .: "label"
<*> o .: "ref"
<*> o .: "sha"
<*> o .: "user"
<*> o .: "repo"
parseJSON _ = fail "Could not build a PullRequestCommit"
instance FromJSON PullRequestEvent where
parseJSON (Object o) =
PullRequestEvent <$> o .: "action"
<*> o .: "number"
<*> o .: "pull_request"
<*> o .: "repository"
<*> o .: "sender"
parseJSON _ = fail "Could not build a PullRequestEvent"
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 RepoWebhookEvent where
parseJSON (String "*") = pure WebhookWildcardEvent
parseJSON (String "commit_comment") = pure WebhookCommitCommentEvent
parseJSON (String "create") = pure WebhookCreateEvent
parseJSON (String "delete") = pure WebhookDeleteEvent
parseJSON (String "deployment") = pure WebhookDeploymentEvent
parseJSON (String "deployment_status") = pure WebhookDeploymentStatusEvent
parseJSON (String "fork") = pure WebhookForkEvent
parseJSON (String "gollum") = pure WebhookGollumEvent
parseJSON (String "issue_comment") = pure WebhookIssueCommentEvent
parseJSON (String "issues") = pure WebhookIssuesEvent
parseJSON (String "member") = pure WebhookMemberEvent
parseJSON (String "page_build") = pure WebhookPageBuildEvent
parseJSON (String "public") = pure WebhookPublicEvent
parseJSON (String "pull_request_review_comment") = pure WebhookPullRequestReviewCommentEvent
parseJSON (String "pull_request") = pure WebhookPullRequestEvent
parseJSON (String "push") = pure WebhookPushEvent
parseJSON (String "release") = pure WebhookReleaseEvent
parseJSON (String "status") = pure WebhookStatusEvent
parseJSON (String "team_add") = pure WebhookTeamAddEvent
parseJSON (String "watch") = pure WebhookWatchEvent
parseJSON _ = fail "Could not build a Webhook event"
instance ToJSON RepoWebhookEvent where
toJSON (WebhookWildcardEvent) = String "*"
toJSON (WebhookCommitCommentEvent) = String "commit_comment"
toJSON (WebhookCreateEvent) = String "create"
toJSON (WebhookDeleteEvent) = String "delete"
toJSON (WebhookDeploymentEvent) = String "deployment"
toJSON (WebhookDeploymentStatusEvent) = String "deployment_status"
toJSON (WebhookForkEvent) = String "fork"
toJSON (WebhookGollumEvent) = String "gollum"
toJSON (WebhookIssueCommentEvent) = String "issue_comment"
toJSON (WebhookIssuesEvent) = String "issues"
toJSON (WebhookMemberEvent) = String "member"
toJSON (WebhookPageBuildEvent) = String "page_build"
toJSON (WebhookPublicEvent) = String "public"
toJSON (WebhookPullRequestReviewCommentEvent) = String "pull_request_review_comment"
toJSON (WebhookPullRequestEvent) = String "pull_request"
toJSON (WebhookPushEvent) = String "push"
toJSON (WebhookReleaseEvent) = String "release"
toJSON (WebhookStatusEvent) = String "status"
toJSON (WebhookTeamAddEvent) = String "team_add"
toJSON (WebhookWatchEvent) = String "watch"
instance FromJSON PingEvent where
parseJSON (Object o) =
PingEvent <$> o .: "zen"
<*> o .: "hook"
<*> o .: "hook_id"
parseJSON _ = fail "Could not build a PingEvent"
instance FromJSON SearchReposResult where
parseJSON (Object o) =
SearchReposResult <$> o .: "total_count"
<*> o .:< "items"
parseJSON _ = fail "Could not build a SearchReposResult"
instance FromJSON Repo where
parseJSON (Object o) =
Repo <$> o .:? "ssh_url"
<*> o .: "description"
<*> o .:? "created_at"
<*> o .: "html_url"
<*> o .:? "svn_url"
<*> o .:? "forks"
<*> o .:? "homepage"
<*> o .: "fork"
<*> o .:? "git_url"
<*> o .: "private"
<*> o .:? "clone_url"
<*> o .:? "size"
<*> o .:? "updated_at"
<*> o .:? "watchers"
<*> o .: "owner"
<*> o .: "name"
<*> o .:? "language"
<*> o .:? "master_branch"
<*> o .:? "pushed_at"
<*> o .: "id"
<*> o .: "url"
<*> o .:? "open_issues"
<*> o .:? "has_wiki"
<*> o .:? "has_issues"
<*> o .:? "has_downloads"
<*> o .:? "parent"
<*> o .:? "source"
<*> o .: "hooks_url"
parseJSON _ = fail "Could not build a Repo"
instance FromJSON SearchCodeResult where
parseJSON (Object o) =
SearchCodeResult <$> o .: "total_count"
<*> o .:< "items"
parseJSON _ = fail "Could not build a SearchCodeResult"
instance FromJSON Code where
parseJSON (Object o ) =
Code <$> o .: "name"
<*> o .: "path"
<*> o .: "sha"
<*> o .: "url"
<*> o .: "git_url"
<*> o .: "html_url"
<*> o .: "repository"
parseJSON _ = fail "Could not build a Code"
instance FromJSON RepoRef where
parseJSON (Object o) =
RepoRef <$> o .: "owner"
<*> o .: "name"
parseJSON _ = fail "Could not build a RepoRef"
instance FromJSON Contributor where
parseJSON (Object o)
| o `at` "type" == (Just "Anonymous") =
AnonymousContributor <$> o .: "contributions"
<*> o .: "name"
| otherwise =
KnownContributor <$> o .: "contributions"
<*> o .: "avatar_url"
<*> o .: "login"
<*> o .: "url"
<*> o .: "id"
<*> o .: "gravatar_id"
parseJSON _ = fail "Could not build a Contributor"
instance FromJSON Languages where
parseJSON (Object o) =
Languages <$>
mapM (\name -> Language (T.unpack name) <$> o .: name)
(Map.keys o)
parseJSON _ = fail "Could not build Languages"
instance FromJSON Tag where
parseJSON (Object o) =
Tag <$> o .: "name"
<*> o .: "zipball_url"
<*> o .: "tarball_url"
<*> o .: "commit"
parseJSON _ = fail "Could not build a Tag"
instance FromJSON Branch where
parseJSON (Object o) = Branch <$> o .: "name" <*> o .: "commit"
parseJSON _ = fail "Could not build a Branch"
instance FromJSON BranchCommit where
parseJSON (Object o) = BranchCommit <$> o .: "sha" <*> o .: "url"
parseJSON _ = fail "Could not build a BranchCommit"
instance FromJSON DetailedOwner where
parseJSON (Object o)
| o `at` "gravatar_id" == Nothing =
DetailedOrganization <$> o .: "created_at"
<*> o .: "type"
<*> o .: "public_gists"
<*> o .: "avatar_url"
<*> o .: "followers"
<*> o .: "following"
<*> o .:? "blog"
<*> o .:? "bio"
<*> o .: "public_repos"
<*> o .:? "name"
<*> o .:? "location"
<*> o .:? "company"
<*> o .: "url"
<*> o .: "id"
<*> o .: "html_url"
<*> o .: "login"
| otherwise =
DetailedUser <$> o .: "created_at"
<*> o .: "type"
<*> o .: "public_gists"
<*> o .: "avatar_url"
<*> o .: "followers"
<*> o .: "following"
<*> o .:? "hireable"
<*> o .: "gravatar_id"
<*> o .:? "blog"
<*> o .:? "bio"
<*> o .: "public_repos"
<*> o .:? "name"
<*> o .:? "location"
<*> o .:? "company"
<*> o .:? "email"
<*> o .: "url"
<*> o .: "id"
<*> o .: "html_url"
<*> o .: "login"
parseJSON _ = fail "Could not build a DetailedOwner"
instance FromJSON RepoWebhook where
parseJSON (Object o) =
RepoWebhook <$> o .: "url"
<*> o .: "test_url"
<*> o .: "id"
<*> o .: "name"
<*> o .: "active"
<*> o .: "events"
<*> o .: "config"
<*> o .: "last_response"
<*> o .: "updated_at"
<*> o .: "created_at"
parseJSON _ = fail "Could not build a RepoWebhook"
instance FromJSON RepoWebhookResponse where
parseJSON (Object o) =
RepoWebhookResponse <$> o .: "code"
<*> o .: "status"
<*> o .: "message"
parseJSON _ = fail "Could not build a RepoWebhookResponse"
instance FromJSON Content where
parseJSON o@(Object _) = ContentFile <$> parseJSON o
parseJSON (Array os) = ContentDirectory <$> (mapM parseJSON $ V.toList os)
parseJSON _ = fail "Could not build a Content"
instance FromJSON ContentData where
parseJSON (Object o) =
ContentData <$> o .: "type"
<*> o .: "encoding"
<*> o .: "size"
<*> o .: "name"
<*> o .: "path"
<*> o .: "content"
<*> o .: "sha"
<*> o .: "url"
<*> o .: "git_url"
<*> o .: "html_url"
parseJSON _ = fail "Could not build a ContentData"
(.:<) :: (FromJSON a) => Object -> T.Text -> Parser [a]
obj .:< key = case Map.lookup key obj of
Nothing -> pure mzero
Just v -> parseJSON v
values :: (Eq k, Hashable k, FromJSON v) => Map.HashMap k Value -> k -> Parser v
obj `values` key =
let (Object children) = findWithDefault (Object Map.empty) key obj in
parseJSON $ Array $ V.fromList $ Map.elems children
(<.:>) :: (FromJSON v) => Object -> [T.Text] -> Parser v
obj <.:> [key] = obj .: key
obj <.:> (key:keys) =
let (Object nextObj) = findWithDefault (Object Map.empty) key obj in
nextObj <.:> keys
_ <.:> [] = fail "must have a pair"
at :: Object -> T.Text -> Maybe Value
obj `at` key = Map.lookup key obj
findWithDefault :: (Eq k, Hashable k) => v -> k -> Map.HashMap k v -> v
findWithDefault def k m =
case Map.lookup k m of
Nothing -> def
Just x -> x