diff --git a/Github/Auth.hs b/Github/Auth.hs
deleted file mode 100644
--- a/Github/Auth.hs
+++ /dev/null
@@ -1,4 +0,0 @@
--- | The Github auth data type
-module Github.Auth (P.GithubAuth(..)) where
-
-import qualified Github.Private as P
diff --git a/Github/Data.hs b/Github/Data.hs
deleted file mode 100644
--- a/Github/Data.hs
+++ /dev/null
@@ -1,721 +0,0 @@
-{-# LANGUAGE CPP, DeriveDataTypeable, OverloadedStrings #-}
-
--- | This module re-exports the @Github.Data.Definitions@ module, adding
--- instances of @FromJSON@ to it. If you wish to use the data without the
--- instances, use the @Github.Data.Definitions@ module instead.
-
-module Github.Data (module Github.Data.Definitions) where
-
-import Control.Applicative
-import Control.Monad
-import qualified Data.Text as T
-import Data.Aeson.Types
-import qualified Data.Vector as V
-import qualified Data.HashMap.Lazy as Map
-import Data.Hashable (Hashable)
-
-#if MIN_VERSION_base(4,8,0)
-import Data.Time
-#else
-import Data.Time
-import System.Locale (defaultTimeLocale)
-#endif
-
-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 ToJSON NewGitReference where
- toJSON (NewGitReference r s) = object [ "ref" .= r, "sha" .= s ]
-
-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 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 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"
-
--- | A slightly more generic version of Aeson's @(.:?)@, using `mzero' instead
--- of `Nothing'.
-(.:<) :: (FromJSON a) => Object -> T.Text -> Parser [a]
-obj .:< key = case Map.lookup key obj of
- Nothing -> pure mzero
- Just v -> parseJSON v
-
--- | Produce all values for the given key.
-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
-
--- | Produce the value for the last key by traversing.
-(<.:>) :: (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"
-
--- | Produce the value for the given key, maybe.
-at :: Object -> T.Text -> Maybe Value
-obj `at` key = Map.lookup key obj
-
--- Taken from Data.Map:
-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
diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs
deleted file mode 100644
--- a/Github/Data/Definitions.hs
+++ /dev/null
@@ -1,624 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
-
-module Github.Data.Definitions where
-
-import Data.Time
-import Data.Data
-import qualified Control.Exception as E
-import qualified Data.Map as M
-
--- | Errors have been tagged according to their source, so you can more easily
--- dispatch and handle them.
-data Error =
- HTTPConnectionError E.SomeException -- ^ A HTTP error occurred. The actual caught error is included.
- | ParseError String -- ^ An error in the parser itself.
- | JsonError String -- ^ The JSON is malformed or unexpected.
- | UserError String -- ^ Incorrect input.
- deriving Show
-
--- | A date in the Github format, which is a special case of ISO-8601.
-newtype GithubDate = GithubDate { fromGithubDate :: UTCTime }
- deriving (Show, Data, Typeable, Eq, Ord)
-
-data Commit = Commit {
- commitSha :: String
- ,commitParents :: [Tree]
- ,commitUrl :: String
- ,commitGitCommit :: GitCommit
- ,commitCommitter :: Maybe GithubOwner
- ,commitAuthor :: Maybe GithubOwner
- ,commitFiles :: [File]
- ,commitStats :: Maybe Stats
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data Tree = Tree {
- treeSha :: String
- ,treeUrl :: String
- ,treeGitTrees :: [GitTree]
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data GitTree = GitTree {
- gitTreeType :: String
- ,gitTreeSha :: String
- -- Can be empty for submodule
- ,gitTreeUrl :: Maybe String
- ,gitTreeSize :: Maybe Int
- ,gitTreePath :: String
- ,gitTreeMode :: String
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data GitCommit = GitCommit {
- gitCommitMessage :: String
- ,gitCommitUrl :: String
- ,gitCommitCommitter :: GitUser
- ,gitCommitAuthor :: GitUser
- ,gitCommitTree :: Tree
- ,gitCommitSha :: Maybe String
- ,gitCommitParents :: [Tree]
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data GithubOwner = GithubUser {
- githubOwnerAvatarUrl :: String
- ,githubOwnerLogin :: String
- ,githubOwnerUrl :: String
- ,githubOwnerId :: Int
- ,githubOwnerGravatarId :: Maybe String
- }
- | GithubOrganization {
- githubOwnerAvatarUrl :: String
- ,githubOwnerLogin :: String
- ,githubOwnerUrl :: String
- ,githubOwnerId :: Int
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data GitUser = GitUser {
- gitUserName :: String
- ,gitUserEmail :: String
- ,gitUserDate :: GithubDate
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data File = File {
- fileBlobUrl :: String
- ,fileStatus :: String
- ,fileRawUrl :: String
- ,fileAdditions :: Int
- ,fileSha :: String
- ,fileChanges :: Int
- ,filePatch :: String
- ,fileFilename :: String
- ,fileDeletions :: Int
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data Stats = Stats {
- statsAdditions :: Int
- ,statsTotal :: Int
- ,statsDeletions :: Int
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data Comment = Comment {
- commentPosition :: Maybe Int
- ,commentLine :: Maybe Int
- ,commentBody :: String
- ,commentCommitId :: Maybe String
- ,commentUpdatedAt :: UTCTime
- ,commentHtmlUrl :: Maybe String
- ,commentUrl :: String
- ,commentCreatedAt :: Maybe UTCTime
- ,commentPath :: Maybe String
- ,commentUser :: GithubOwner
- ,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
- ,diffPatchUrl :: String
- ,diffUrl :: String
- ,diffBaseCommit :: Commit
- ,diffCommits :: [Commit]
- ,diffTotalCommits :: Int
- ,diffHtmlUrl :: String
- ,diffFiles :: [File]
- ,diffAheadBy :: Int
- ,diffDiffUrl :: String
- ,diffPermalinkUrl :: String
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data Gist = Gist {
- gistUser :: GithubOwner
- ,gistGitPushUrl :: String
- ,gistUrl :: String
- ,gistDescription :: Maybe String
- ,gistCreatedAt :: GithubDate
- ,gistPublic :: Bool
- ,gistComments :: Int
- ,gistUpdatedAt :: GithubDate
- ,gistHtmlUrl :: String
- ,gistId :: String
- ,gistFiles :: [GistFile]
- ,gistGitPullUrl :: String
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data GistFile = GistFile {
- gistFileType :: String
- ,gistFileRawUrl :: String
- ,gistFileSize :: Int
- ,gistFileLanguage :: Maybe String
- ,gistFileFilename :: String
- ,gistFileContent :: Maybe String
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data GistComment = GistComment {
- gistCommentUser :: GithubOwner
- ,gistCommentUrl :: String
- ,gistCommentCreatedAt :: GithubDate
- ,gistCommentBody :: String
- ,gistCommentUpdatedAt :: GithubDate
- ,gistCommentId :: Int
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data Blob = Blob {
- blobUrl :: String
- ,blobEncoding :: String
- ,blobContent :: String
- ,blobSha :: String
- ,blobSize :: Int
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data NewGitReference = NewGitReference {
- newGitReferenceRef :: String
- ,newGitReferenceSha :: String
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data GitReference = GitReference {
- gitReferenceObject :: GitObject
- ,gitReferenceUrl :: String
- ,gitReferenceRef :: String
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data GitObject = GitObject {
- gitObjectType :: String
- ,gitObjectSha :: String
- ,gitObjectUrl :: String
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data Issue = Issue {
- issueClosedAt :: Maybe GithubDate
- ,issueUpdatedAt :: GithubDate
- ,issueEventsUrl :: String
- ,issueHtmlUrl :: Maybe String
- ,issueClosedBy :: Maybe GithubOwner
- ,issueLabels :: [IssueLabel]
- ,issueNumber :: Int
- ,issueAssignee :: Maybe GithubOwner
- ,issueUser :: GithubOwner
- ,issueTitle :: String
- ,issuePullRequest :: Maybe PullRequestReference
- ,issueUrl :: String
- ,issueCreatedAt :: GithubDate
- ,issueBody :: Maybe String
- ,issueState :: String
- ,issueId :: Int
- ,issueComments :: Int
- ,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
- ,milestoneOpenIssues :: Int
- ,milestoneNumber :: Int
- ,milestoneClosedIssues :: Int
- ,milestoneDescription :: Maybe String
- ,milestoneTitle :: String
- ,milestoneUrl :: String
- ,milestoneCreatedAt :: GithubDate
- ,milestoneState :: String
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data IssueLabel = IssueLabel {
- labelColor :: String
- ,labelUrl :: String
- ,labelName :: String
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data PullRequestReference = PullRequestReference {
- pullRequestReferenceHtmlUrl :: Maybe String
- ,pullRequestReferencePatchUrl :: Maybe String
- ,pullRequestReferenceDiffUrl :: Maybe String
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data IssueComment = IssueComment {
- issueCommentUpdatedAt :: GithubDate
- ,issueCommentUser :: GithubOwner
- ,issueCommentUrl :: String
- ,issueCommentCreatedAt :: GithubDate
- ,issueCommentBody :: String
- ,issueCommentId :: Int
-} deriving (Show, Data, Typeable, Eq, Ord)
-
--- | Data describing an @Event@.
-data EventType =
- Mentioned -- ^ The actor was @mentioned in an issue body.
- | Subscribed -- ^ The actor subscribed to receive notifications for an issue.
- | Unsubscribed -- ^ The issue was unsubscribed from by the actor.
- | Referenced -- ^ The issue was referenced from a commit message. The commit_id attribute is the commit SHA1 of where that happened.
- | Merged -- ^ The issue was merged by the actor. The commit_id attribute is the SHA1 of the HEAD commit that was merged.
- | Assigned -- ^ The issue was assigned to the actor.
- | Closed -- ^ The issue was closed by the actor. When the commit_id is present, it identifies the commit that closed the issue using “closes / fixes #NN” syntax.
- | Reopened -- ^ The issue was reopened by the actor.
- | ActorUnassigned -- ^ The issue was unassigned to the actor
- | Labeled -- ^ A label was added to the issue.
- | Unlabeled -- ^ A label was removed from the issue.
- | Milestoned -- ^ The issue was added to a milestone.
- | Demilestoned -- ^ The issue was removed from a milestone.
- | Renamed -- ^ The issue title was changed.
- | Locked -- ^ The issue was locked by the actor.
- | Unlocked -- ^ The issue was unlocked by the actor.
- | HeadRefDeleted -- ^ The pull request’s branch was deleted.
- | HeadRefRestored -- ^ The pull request’s branch was restored.
- deriving (Show, Data, Typeable, Eq, Ord)
-
-data Event = Event {
- eventActor :: GithubOwner
- ,eventType :: EventType
- ,eventCommitId :: Maybe String
- ,eventUrl :: String
- ,eventCreatedAt :: GithubDate
- ,eventId :: Int
- ,eventIssue :: Maybe Issue
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data SimpleOrganization = SimpleOrganization {
- simpleOrganizationUrl :: String
- ,simpleOrganizationAvatarUrl :: String
- ,simpleOrganizationId :: Int
- ,simpleOrganizationLogin :: String
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data Organization = Organization {
- organizationType :: String
- ,organizationBlog :: Maybe String
- ,organizationLocation :: Maybe String
- ,organizationLogin :: String
- ,organizationFollowers :: Int
- ,organizationCompany :: Maybe String
- ,organizationAvatarUrl :: String
- ,organizationPublicGists :: Int
- ,organizationHtmlUrl :: String
- ,organizationEmail :: Maybe String
- ,organizationFollowing :: Int
- ,organizationPublicRepos :: Int
- ,organizationUrl :: String
- ,organizationCreatedAt :: GithubDate
- ,organizationName :: Maybe String
- ,organizationId :: Int
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data PullRequest = PullRequest {
- pullRequestClosedAt :: Maybe GithubDate
- ,pullRequestCreatedAt :: GithubDate
- ,pullRequestUser :: GithubOwner
- ,pullRequestPatchUrl :: String
- ,pullRequestState :: String
- ,pullRequestNumber :: Int
- ,pullRequestHtmlUrl :: String
- ,pullRequestUpdatedAt :: GithubDate
- ,pullRequestBody :: String
- ,pullRequestIssueUrl :: String
- ,pullRequestDiffUrl :: String
- ,pullRequestUrl :: String
- ,pullRequestLinks :: PullRequestLinks
- ,pullRequestMergedAt :: Maybe GithubDate
- ,pullRequestTitle :: String
- ,pullRequestId :: Int
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data DetailedPullRequest = DetailedPullRequest {
- -- this is a duplication of a PullRequest
- detailedPullRequestClosedAt :: Maybe GithubDate
- ,detailedPullRequestCreatedAt :: GithubDate
- ,detailedPullRequestUser :: GithubOwner
- ,detailedPullRequestPatchUrl :: String
- ,detailedPullRequestState :: String
- ,detailedPullRequestNumber :: Int
- ,detailedPullRequestHtmlUrl :: String
- ,detailedPullRequestUpdatedAt :: GithubDate
- ,detailedPullRequestBody :: String
- ,detailedPullRequestIssueUrl :: String
- ,detailedPullRequestDiffUrl :: String
- ,detailedPullRequestUrl :: String
- ,detailedPullRequestLinks :: PullRequestLinks
- ,detailedPullRequestMergedAt :: Maybe GithubDate
- ,detailedPullRequestTitle :: String
- ,detailedPullRequestId :: Int
-
- ,detailedPullRequestMergedBy :: Maybe GithubOwner
- ,detailedPullRequestChangedFiles :: Int
- ,detailedPullRequestHead :: PullRequestCommit
- ,detailedPullRequestComments :: Int
- ,detailedPullRequestDeletions :: Int
- ,detailedPullRequestAdditions :: Int
- ,detailedPullRequestReviewComments :: Int
- ,detailedPullRequestBase :: PullRequestCommit
- ,detailedPullRequestCommits :: Int
- ,detailedPullRequestMerged :: Bool
- ,detailedPullRequestMergeable :: Maybe Bool
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data EditPullRequest = EditPullRequest {
- editPullRequestTitle :: Maybe String
- ,editPullRequestBody :: Maybe String
- ,editPullRequestState :: Maybe EditPullRequestState
-} deriving (Show)
-
-data CreatePullRequest =
- CreatePullRequest
- { createPullRequestTitle :: String
- , createPullRequestBody :: String
- , createPullRequestHead :: String
- , createPullRequestBase :: String
- }
- | CreatePullRequestIssue
- { createPullRequestIssueNum :: Int
- , createPullRequestHead :: String
- , createPullRequestBase :: String
- }
- deriving (Show)
-
-data PullRequestLinks = PullRequestLinks {
- pullRequestLinksReviewComments :: String
- ,pullRequestLinksComments :: String
- ,pullRequestLinksHtml :: String
- ,pullRequestLinksSelf :: String
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data PullRequestCommit = PullRequestCommit {
- pullRequestCommitLabel :: String
- ,pullRequestCommitRef :: String
- ,pullRequestCommitSha :: String
- ,pullRequestCommitUser :: GithubOwner
- ,pullRequestCommitRepo :: Repo
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data SearchReposResult = SearchReposResult {
- searchReposTotalCount :: Int
- ,searchReposRepos :: [Repo]
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data Repo = Repo {
- repoSshUrl :: Maybe String
- ,repoDescription :: Maybe String
- ,repoCreatedAt :: Maybe GithubDate
- ,repoHtmlUrl :: String
- ,repoSvnUrl :: Maybe String
- ,repoForks :: Maybe Int
- ,repoHomepage :: Maybe String
- ,repoFork :: Maybe Bool
- ,repoGitUrl :: Maybe String
- ,repoPrivate :: Bool
- ,repoCloneUrl :: Maybe String
- ,repoSize :: Maybe Int
- ,repoUpdatedAt :: Maybe GithubDate
- ,repoWatchers :: Maybe Int
- ,repoOwner :: GithubOwner
- ,repoName :: String
- ,repoLanguage :: Maybe String
- ,repoMasterBranch :: Maybe String
- ,repoPushedAt :: Maybe GithubDate -- ^ this is Nothing for new repositories
- ,repoId :: Int
- ,repoUrl :: String
- ,repoOpenIssues :: Maybe Int
- ,repoHasWiki :: Maybe Bool
- ,repoHasIssues :: Maybe Bool
- ,repoHasDownloads :: Maybe Bool
- ,repoParent :: Maybe RepoRef
- ,repoSource :: Maybe RepoRef
- ,repoHooksUrl :: String
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data RepoRef = RepoRef GithubOwner String -- Repo owner and name
- deriving (Show, Data, Typeable, Eq, Ord)
-
-data SearchCodeResult = SearchCodeResult {
- searchCodeTotalCount :: Int
- ,searchCodeCodes :: [Code]
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data Code = Code {
- codeName :: String
- ,codePath :: String
- ,codeSha :: String
- ,codeUrl :: String
- ,codeGitUrl :: String
- ,codeHtmlUrl :: String
- ,codeRepo :: Repo
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data Content = ContentFile ContentData | ContentDirectory [ContentData]
- deriving (Show, Data, Typeable, Eq, Ord)
-
-data ContentData = ContentData {
- contentType :: String
- ,contentEncoding :: String
- ,contentSize :: Int
- ,contentName :: String
- ,contentPath :: String
- ,contentData :: String
- ,contentSha :: String
- ,contentUrl :: String
- ,contentGitUrl :: String
- ,contentHtmlUrl :: String
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data Contributor
- -- | An existing Github user, with their number of contributions, avatar
- -- URL, login, URL, ID, and Gravatar ID.
- = KnownContributor Int String String String Int String
- -- | An unknown Github user with their number of contributions and recorded name.
- | AnonymousContributor Int String
- deriving (Show, Data, Typeable, Eq, Ord)
-
--- | This is only used for the FromJSON instance.
-data Languages = Languages { getLanguages :: [Language] }
- deriving (Show, Data, Typeable, Eq, Ord)
-
--- | A programming language with the name and number of characters written in
--- it.
-data Language = Language String Int
- deriving (Show, Data, Typeable, Eq, Ord)
-
-data Tag = Tag {
- tagName :: String
- ,tagZipballUrl :: String
- ,tagTarballUrl :: String
- ,tagCommit :: BranchCommit
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data Branch = Branch {
- branchName :: String
- ,branchCommit :: BranchCommit
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data BranchCommit = BranchCommit {
- branchCommitSha :: String
- ,branchCommitUrl :: String
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data DetailedOwner = DetailedUser {
- detailedOwnerCreatedAt :: GithubDate
- ,detailedOwnerType :: String
- ,detailedOwnerPublicGists :: Int
- ,detailedOwnerAvatarUrl :: String
- ,detailedOwnerFollowers :: Int
- ,detailedOwnerFollowing :: Int
- ,detailedOwnerHireable :: Maybe Bool
- ,detailedOwnerGravatarId :: Maybe String
- ,detailedOwnerBlog :: Maybe String
- ,detailedOwnerBio :: Maybe String
- ,detailedOwnerPublicRepos :: Int
- ,detailedOwnerName :: Maybe String
- ,detailedOwnerLocation :: Maybe String
- ,detailedOwnerCompany :: Maybe String
- ,detailedOwnerEmail :: Maybe String
- ,detailedOwnerUrl :: String
- ,detailedOwnerId :: Int
- ,detailedOwnerHtmlUrl :: String
- ,detailedOwnerLogin :: String
- }
- | DetailedOrganization {
- detailedOwnerCreatedAt :: GithubDate
- ,detailedOwnerType :: String
- ,detailedOwnerPublicGists :: Int
- ,detailedOwnerAvatarUrl :: String
- ,detailedOwnerFollowers :: Int
- ,detailedOwnerFollowing :: Int
- ,detailedOwnerBlog :: Maybe String
- ,detailedOwnerBio :: Maybe String
- ,detailedOwnerPublicRepos :: Int
- ,detailedOwnerName :: Maybe String
- ,detailedOwnerLocation :: Maybe String
- ,detailedOwnerCompany :: Maybe String
- ,detailedOwnerUrl :: String
- ,detailedOwnerId :: Int
- ,detailedOwnerHtmlUrl :: String
- ,detailedOwnerLogin :: String
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data RepoWebhook = RepoWebhook {
- repoWebhookUrl :: String
- ,repoWebhookTestUrl :: String
- ,repoWebhookId :: Integer
- ,repoWebhookName :: String
- ,repoWebhookActive :: Bool
- ,repoWebhookEvents :: [RepoWebhookEvent]
- ,repoWebhookConfig :: M.Map String String
- ,repoWebhookLastResponse :: RepoWebhookResponse
- ,repoWebhookUpdatedAt :: GithubDate
- ,repoWebhookCreatedAt :: GithubDate
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data RepoWebhookEvent =
- WebhookWildcardEvent
- | WebhookCommitCommentEvent
- | WebhookCreateEvent
- | WebhookDeleteEvent
- | WebhookDeploymentEvent
- | WebhookDeploymentStatusEvent
- | WebhookForkEvent
- | WebhookGollumEvent
- | WebhookIssueCommentEvent
- | WebhookIssuesEvent
- | WebhookMemberEvent
- | WebhookPageBuildEvent
- | WebhookPublicEvent
- | WebhookPullRequestReviewCommentEvent
- | WebhookPullRequestEvent
- | WebhookPushEvent
- | WebhookReleaseEvent
- | WebhookStatusEvent
- | WebhookTeamAddEvent
- | WebhookWatchEvent
- deriving (Show, Data, Typeable, Eq, Ord)
-
-data RepoWebhookResponse = RepoWebhookResponse {
- repoWebhookResponseCode :: Maybe Int
- ,repoWebhookResponseStatus :: String
- ,repoWebhookResponseMessage :: Maybe String
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data PullRequestEvent = PullRequestEvent {
- pullRequestEventAction :: PullRequestEventType
- ,pullRequestEventNumber :: Int
- ,pullRequestEventPullRequest :: DetailedPullRequest
- ,pullRequestRepository :: Repo
- ,pullRequestSender :: GithubOwner
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data PullRequestEventType =
- PullRequestOpened
- | PullRequestClosed
- | PullRequestSynchronized
- | PullRequestReopened
- | PullRequestAssigned
- | PullRequestUnassigned
- | PullRequestLabeled
- | PullRequestUnlabeled
- deriving (Show, Data, Typeable, Eq, Ord)
-
-data PingEvent = PingEvent {
- pingEventZen :: String
- ,pingEventHook :: RepoWebhook
- ,pingEventHookId :: Int
-} deriving (Show, Data, Typeable, Eq, Ord)
-
-data EditPullRequestState =
- EditPullRequestStateOpen
- | EditPullRequestStateClosed
- deriving Show
diff --git a/Github/Events.hs b/Github/Events.hs
deleted file mode 100644
--- a/Github/Events.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module Github.Events (
- parseEvent
-) where
-
-import qualified Data.ByteString.Lazy.Char8 as LBS
-
-import Data.Aeson (FromJSON)
-
-import Github.Data.Definitions (Error(..))
-import Github.Private (parseJson)
-
-parseEvent :: (FromJSON b, Show b) => LBS.ByteString -> Either Error b
-parseEvent = parseJson
diff --git a/Github/Gists.hs b/Github/Gists.hs
deleted file mode 100644
--- a/Github/Gists.hs
+++ /dev/null
@@ -1,35 +0,0 @@
--- | The gists API as described at .
-module Github.Gists (
- gists
-,gists'
-,gist
-,gist'
-,module Github.Data
-) where
-
-import Github.Data
-import Github.Private
-
--- | The list of all gists created by the user
---
--- > gists' (Just ("github-username", "github-password")) "mike-burns"
-gists' :: Maybe GithubAuth -> String -> IO (Either Error [Gist])
-gists' auth userName = githubGet' auth ["users", userName, "gists"]
-
--- | The list of all public gists created by the user.
---
--- > gists "mike-burns"
-gists :: String -> IO (Either Error [Gist])
-gists = gists' Nothing
-
--- | A specific gist, given its id, with authentication credentials
---
--- > gist' (Just ("github-username", "github-password")) "225074"
-gist' :: Maybe GithubAuth -> String -> IO (Either Error Gist)
-gist' auth reqGistId = githubGet' auth ["gists", reqGistId]
-
--- | A specific gist, given its id.
---
--- > gist "225074"
-gist :: String -> IO (Either Error Gist)
-gist = gist' Nothing
diff --git a/Github/Gists/Comments.hs b/Github/Gists/Comments.hs
deleted file mode 100644
--- a/Github/Gists/Comments.hs
+++ /dev/null
@@ -1,22 +0,0 @@
--- | The loving comments people have left on Gists, described on
--- .
-module Github.Gists.Comments (
- commentsOn
-,comment
-,module Github.Data
-) where
-
-import Github.Data
-import Github.Private
-
--- | All the comments on a Gist, given the Gist ID.
---
--- > commentsOn "1174060"
-commentsOn :: String -> IO (Either Error [GistComment])
-commentsOn reqGistId = githubGet ["gists", reqGistId, "comments"]
-
--- | A specific comment, by the comment ID.
---
--- > comment "62449"
-comment :: String -> IO (Either Error GistComment)
-comment reqCommentId = githubGet ["gists", "comments", reqCommentId]
diff --git a/Github/GitData/Blobs.hs b/Github/GitData/Blobs.hs
deleted file mode 100644
--- a/Github/GitData/Blobs.hs
+++ /dev/null
@@ -1,16 +0,0 @@
--- | The API for dealing with git blobs from Github repos, as described in
--- .
-module Github.GitData.Blobs (
- blob
-,module Github.Data
-) where
-
-import Github.Data
-import Github.Private
-
--- | Get a blob by SHA1.
---
--- > blob "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9"
-blob :: String -> String -> String -> IO (Either Error Blob)
-blob user reqRepoName sha =
- githubGet ["repos", user, reqRepoName, "git", "blobs", sha]
diff --git a/Github/GitData/Commits.hs b/Github/GitData/Commits.hs
deleted file mode 100644
--- a/Github/GitData/Commits.hs
+++ /dev/null
@@ -1,16 +0,0 @@
--- | The API for underlying git commits of a Github repo, as described on
--- .
-module Github.GitData.Commits (
- commit
-,module Github.Data
-) where
-
-import Github.Data
-import Github.Private
-
--- | A single commit, by SHA1.
---
--- > commit "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9"
-commit :: String -> String -> String -> IO (Either Error GitCommit)
-commit user reqRepoName sha =
- githubGet ["repos", user, reqRepoName, "git", "commits", sha]
diff --git a/Github/GitData/References.hs b/Github/GitData/References.hs
deleted file mode 100644
--- a/Github/GitData/References.hs
+++ /dev/null
@@ -1,38 +0,0 @@
--- | The underlying git references on a Github repo, exposed for the world to
--- see. The git internals documentation will also prove handy for understanding
--- these. API documentation at .
-module Github.GitData.References (
- reference
-,references
-,createReference
-,namespacedReferences
-,module Github.Data
-) where
-
-import Github.Data
-import Github.Private
-
--- | A single reference by the ref name.
---
--- > reference "mike-burns" "github" "heads/master"
-reference :: String -> String -> String -> IO (Either Error GitReference)
-reference user reqRepoName ref =
- githubGet ["repos", user, reqRepoName, "git", "refs", ref]
-
--- | The history of references for a repo.
---
--- > references "mike-burns" "github"
-references :: String -> String -> IO (Either Error [GitReference])
-references user reqRepoName =
- githubGet ["repos", user, reqRepoName, "git", "refs"]
-
-createReference :: GithubAuth -> String -> String -> NewGitReference -> IO (Either Error GitReference)
-createReference auth owner reqRepoName newRef =
- githubPost auth ["repos", owner, reqRepoName, "git", "refs"] newRef
-
--- | Limited references by a namespace.
---
--- > namespacedReferences "thoughtbot" "paperclip" "tags"
-namespacedReferences :: String -> String -> String -> IO (Either Error [GitReference])
-namespacedReferences user reqRepoName namespace =
- githubGet ["repos", user, reqRepoName, "git", "refs", namespace]
diff --git a/Github/GitData/Trees.hs b/Github/GitData/Trees.hs
deleted file mode 100644
--- a/Github/GitData/Trees.hs
+++ /dev/null
@@ -1,37 +0,0 @@
--- | The underlying tree of SHA1s and files that make up a git repo. The API is
--- described on .
-module Github.GitData.Trees (
- tree
-,nestedTree
-,module Github.Data
-) where
-
-import Github.Data
-import Github.Private
-
--- | A tree for a SHA1.
---
--- > tree (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844"
-tree' :: Maybe GithubAuth -> String -> String -> String -> IO (Either Error Tree)
-tree' auth user reqRepoName sha =
- githubGet' auth ["repos", user, reqRepoName, "git", "trees", sha]
-
--- | A tree for a SHA1.
---
--- > tree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844"
-tree :: String -> String -> String -> IO (Either Error Tree)
-tree = tree' Nothing
-
--- | A recursively-nested tree for a SHA1.
---
--- > nestedTree' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844"
-nestedTree' :: Maybe GithubAuth -> String -> String -> String -> IO (Either Error Tree)
-nestedTree' auth user reqRepoName sha =
- githubGetWithQueryString' auth ["repos", user, reqRepoName, "git", "trees", sha]
- "recursive=1"
-
--- | A recursively-nested tree for a SHA1.
---
--- > nestedTree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844"
-nestedTree :: String -> String -> String -> IO (Either Error Tree)
-nestedTree = nestedTree' Nothing
diff --git a/Github/Issues.hs b/Github/Issues.hs
deleted file mode 100644
--- a/Github/Issues.hs
+++ /dev/null
@@ -1,129 +0,0 @@
-{-# LANGUAGE CPP, OverloadedStrings #-}
--- | The issues API as described on .
-module Github.Issues (
- issue
-,issue'
-,issuesForRepo
-,issuesForRepo'
-,IssueLimitation(..)
-,createIssue
-,newIssue
-,editIssue
-,editOfIssue
-,module Github.Data
-) where
-
-import Github.Data
-import Github.Private
-import Data.List (intercalate)
-#if MIN_VERSION_base(4, 8, 0)
-import Data.Time (defaultTimeLocale)
-#else
-import System.Locale (defaultTimeLocale)
-#endif
-
-import Data.Time.Format (formatTime)
-import Data.Time.Clock (UTCTime(..))
-
--- | A data structure for describing how to filter issues. This is used by
--- @issuesForRepo@.
-data IssueLimitation =
- AnyMilestone -- ^ Issues appearing in any milestone. [default]
- | NoMilestone -- ^ Issues without a milestone.
- | MilestoneId Int -- ^ Only issues that are in the milestone with the given id.
- | Open -- ^ Only open issues. [default]
- | OnlyClosed -- ^ Only closed issues.
- | Unassigned -- ^ Issues to which no one has been assigned ownership.
- | AnyAssignment -- ^ All issues regardless of assignment. [default]
- | AssignedTo String -- ^ Only issues assigned to the user with the given login.
- | Mentions String -- ^ Issues which mention the given string, taken to be a user's login.
- | Labels [String] -- ^ A list of labels to filter by.
- | Ascending -- ^ Sort ascending.
- | Descending -- ^ Sort descending. [default]
- | Since UTCTime -- ^ Only issues created since the specified date and time.
- | PerPage Int -- ^ Download this many issues per query
-
-
--- | Details on a specific issue, given the repo owner and name, and the issue
--- number.'
---
--- > issue' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "462"
-issue' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error Issue)
-issue' auth user reqRepoName reqIssueNumber =
- githubGet' auth ["repos", user, reqRepoName, "issues", show reqIssueNumber]
-
--- | Details on a specific issue, given the repo owner and name, and the issue
--- number.
---
--- > issue "thoughtbot" "paperclip" "462"
-issue :: String -> String -> Int -> IO (Either Error Issue)
-issue = issue' Nothing
-
--- | All issues for a repo (given the repo owner and name), with optional
--- restrictions as described in the @IssueLimitation@ data type.
---
--- > issuesForRepo' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending]
-issuesForRepo' :: Maybe GithubAuth -> String -> String -> [IssueLimitation] -> IO (Either Error [Issue])
-issuesForRepo' auth user reqRepoName issueLimitations =
- githubGetWithQueryString'
- auth
- ["repos", user, reqRepoName, "issues"]
- (queryStringFromLimitations issueLimitations)
- where
- queryStringFromLimitations = intercalate "&" . map convert
-
- convert AnyMilestone = "milestone=*"
- convert NoMilestone = "milestone=none"
- convert (MilestoneId n) = "milestone=" ++ show n
- convert Open = "state=open"
- convert OnlyClosed = "state=closed"
- convert Unassigned = "assignee=none"
- convert AnyAssignment = "assignee=*"
- convert (AssignedTo u) = "assignee=" ++ u
- convert (Mentions u) = "mentioned=" ++ u
- convert (Labels l) = "labels=" ++ intercalate "," l
- convert Ascending = "direction=asc"
- convert Descending = "direction=desc"
- convert (PerPage n) = "per_page=" ++ show n
- convert (Since t) =
- "since=" ++ formatTime defaultTimeLocale "%FT%TZ" t
-
--- | All issues for a repo (given the repo owner and name), with optional
--- restrictions as described in the @IssueLimitation@ data type.
---
--- > 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
deleted file mode 100644
--- a/Github/Issues/Comments.hs
+++ /dev/null
@@ -1,59 +0,0 @@
--- | The Github issue comments API from
--- .
-module Github.Issues.Comments (
- comment
-,comments
-,comments'
-,createComment
-,editComment
-,module Github.Data
-) where
-
-import Github.Data
-import Github.Private
-
--- | A specific comment, by ID.
---
--- > comment "thoughtbot" "paperclip" 1468184
-comment :: String -> String -> Int -> IO (Either Error IssueComment)
-comment user reqRepoName reqCommentId =
- githubGet ["repos", user, reqRepoName, "issues", "comments", show reqCommentId]
-
--- | All comments on an issue, by the issue's number.
---
--- > comments "thoughtbot" "paperclip" 635
-comments :: String -> String -> Int -> IO (Either Error [IssueComment])
-comments user reqRepoName reqIssueNumber =
- githubGet ["repos", user, reqRepoName, "issues", show reqIssueNumber, "comments"]
-
--- | All comments on an issue, by the issue's number, using authentication.
---
--- > comments' (GithubUser (user, password)) "thoughtbot" "paperclip" 635
-comments' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error [IssueComment])
-comments' auth user reqRepoName reqIssueNumber =
- githubGet' auth ["repos", user, reqRepoName, "issues", show reqIssueNumber, "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/Github/Issues/Events.hs b/Github/Issues/Events.hs
deleted file mode 100644
--- a/Github/Issues/Events.hs
+++ /dev/null
@@ -1,56 +0,0 @@
--- | The Github issue events API, which is described on
---
-module Github.Issues.Events (
- eventsForIssue
-,eventsForIssue'
-,eventsForRepo
-,eventsForRepo'
-,event
-,event'
-,module Github.Data
-) where
-
-import Github.Data
-import Github.Private
-
--- | All events that have happened on an issue.
---
--- > eventsForIssue "thoughtbot" "paperclip" 49
-eventsForIssue :: String -> String -> Int -> IO (Either Error [Event])
-eventsForIssue user reqRepoName reqIssueNumber =
- githubGet ["repos", user, reqRepoName, "issues", show reqIssueNumber, "events"]
-
--- | All events that have happened on an issue, using authentication.
---
--- > eventsForIssue' (GithubUser (user, password)) "thoughtbot" "paperclip" 49
-eventsForIssue' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error [Event])
-eventsForIssue' auth user reqRepoName reqIssueNumber =
- githubGet' auth ["repos", user, reqRepoName, "issues", show reqIssueNumber, "events"]
-
--- | All the events for all issues in a repo.
---
--- > eventsForRepo "thoughtbot" "paperclip"
-eventsForRepo :: String -> String -> IO (Either Error [Event])
-eventsForRepo user reqRepoName =
- githubGet ["repos", user, reqRepoName, "issues", "events"]
-
--- | All the events for all issues in a repo, using authentication.
---
--- > eventsForRepo' (GithubUser (user, password)) "thoughtbot" "paperclip"
-eventsForRepo' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Event])
-eventsForRepo' auth user reqRepoName =
- githubGet' auth ["repos", user, reqRepoName, "issues", "events"]
-
--- | Details on a specific event, by the event's ID.
---
--- > event "thoughtbot" "paperclip" 5335772
-event :: String -> String -> Int -> IO (Either Error Event)
-event user reqRepoName reqEventId =
- githubGet ["repos", user, reqRepoName, "issues", "events", show reqEventId]
-
--- | Details on a specific event, by the event's ID, using authentication.
---
--- > event' (GithubUser (user, password)) "thoughtbot" "paperclip" 5335772
-event' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error Event)
-event' auth user reqRepoName reqEventId =
- githubGet' auth ["repos", user, reqRepoName, "issues", "events", show reqEventId]
diff --git a/Github/Issues/Labels.hs b/Github/Issues/Labels.hs
deleted file mode 100644
--- a/Github/Issues/Labels.hs
+++ /dev/null
@@ -1,39 +0,0 @@
--- | The API for dealing with labels on Github issues, as described on
--- .
-module Github.Issues.Labels (
- label
-,labelsOnRepo
-,labelsOnIssue
-,labelsOnMilestone
-,module Github.Data
-) where
-
-import Github.Data
-import Github.Private
-
--- | All the labels available to use on any issue in the repo.
---
--- > labelsOnRepo "thoughtbot" "paperclip"
-labelsOnRepo :: String -> String -> IO (Either Error [IssueLabel])
-labelsOnRepo user reqRepoName = githubGet ["repos", user, reqRepoName, "labels"]
-
--- | The labels on an issue in a repo.
---
--- > labelsOnIssue "thoughtbot" "paperclip" 585
-labelsOnIssue :: String -> String -> Int -> IO (Either Error [IssueLabel])
-labelsOnIssue user reqRepoName reqIssueId =
- githubGet ["repos", user, reqRepoName, "issues", show reqIssueId, "labels"]
-
--- | All the labels on a repo's milestone, given the milestone ID.
---
--- > labelsOnMilestone "thoughtbot" "paperclip" 2
-labelsOnMilestone :: String -> String -> Int -> IO (Either Error [IssueLabel])
-labelsOnMilestone user reqRepoName milestoneId =
- githubGet ["repos", user, reqRepoName, "milestones", show milestoneId, "labels"]
-
--- | A label, by name.
---
--- > Github.label "thoughtbot" "paperclip" "bug"
-label :: String -> String -> String -> IO (Either Error IssueLabel)
-label user reqRepoName reqLabelName =
- githubGet ["repos", user, reqRepoName, "labels", reqLabelName]
diff --git a/Github/Issues/Milestones.hs b/Github/Issues/Milestones.hs
deleted file mode 100644
--- a/Github/Issues/Milestones.hs
+++ /dev/null
@@ -1,30 +0,0 @@
--- | The milestones API as described on
--- .
-module Github.Issues.Milestones (
- milestones
-,milestones'
-,milestone
-,module Github.Data
-) where
-
-import Github.Data
-import Github.Private
-
--- | All milestones in the repo.
---
--- > milestones "thoughtbot" "paperclip"
-milestones :: String -> String -> IO (Either Error [Milestone])
-milestones = milestones' Nothing
-
--- | All milestones in the repo, using authentication.
---
--- > milestones' (GithubUser (user, password)) "thoughtbot" "paperclip"
-milestones' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Milestone])
-milestones' auth user reqRepoName = githubGet' auth ["repos", user, reqRepoName, "milestones"]
-
--- | Details on a specific milestone, given it's milestone number.
---
--- > milestone "thoughtbot" "paperclip" 2
-milestone :: String -> String -> Int -> IO (Either Error Milestone)
-milestone user reqRepoName reqMilestoneNumber =
- githubGet ["repos", user, reqRepoName, "milestones", show reqMilestoneNumber]
diff --git a/Github/Organizations.hs b/Github/Organizations.hs
deleted file mode 100644
--- a/Github/Organizations.hs
+++ /dev/null
@@ -1,35 +0,0 @@
--- | The orgs API as described on .
-module Github.Organizations (
- publicOrganizationsFor
-,publicOrganizationsFor'
-,publicOrganization
-,publicOrganization'
-,module Github.Data
-) where
-
-import Github.Data
-import Github.Private
-
--- | The public organizations for a user, given the user's login, with authorization
---
--- > publicOrganizationsFor' (Just ("github-username", "github-password")) "mike-burns"
-publicOrganizationsFor' :: Maybe GithubAuth -> String -> IO (Either Error [SimpleOrganization])
-publicOrganizationsFor' auth userName = githubGet' auth ["users", userName, "orgs"]
-
--- | The public organizations for a user, given the user's login.
---
--- > publicOrganizationsFor "mike-burns"
-publicOrganizationsFor :: String -> IO (Either Error [SimpleOrganization])
-publicOrganizationsFor = publicOrganizationsFor' Nothing
-
--- | Details on a public organization. Takes the organization's login.
---
--- > publicOrganization' (Just ("github-username", "github-password")) "thoughtbot"
-publicOrganization' :: Maybe GithubAuth -> String -> IO (Either Error Organization)
-publicOrganization' auth reqOrganizationName = githubGet' auth ["orgs", reqOrganizationName]
-
--- | Details on a public organization. Takes the organization's login.
---
--- > publicOrganization "thoughtbot"
-publicOrganization :: String -> IO (Either Error Organization)
-publicOrganization = publicOrganization' Nothing
diff --git a/Github/Organizations/Members.hs b/Github/Organizations/Members.hs
deleted file mode 100644
--- a/Github/Organizations/Members.hs
+++ /dev/null
@@ -1,15 +0,0 @@
--- | The organization members API as described on
--- .
-module Github.Organizations.Members (
- membersOf
-,module Github.Data
-) where
-
-import Github.Data
-import Github.Private
-
--- | All the users who are members of the specified organization.
---
--- > membersOf "thoughtbot"
-membersOf :: String -> IO (Either Error [GithubOwner])
-membersOf organization = githubGet ["orgs", organization, "members"]
diff --git a/Github/Private.hs b/Github/Private.hs
deleted file mode 100644
--- a/Github/Private.hs
+++ /dev/null
@@ -1,192 +0,0 @@
-{-# LANGUAGE OverloadedStrings, StandaloneDeriving, DeriveDataTypeable #-}
-{-# LANGUAGE CPP, FlexibleContexts #-}
-module Github.Private where
-
-import Github.Data
-import Data.Aeson
-import Data.Attoparsec.ByteString.Lazy
-import Data.Data
-import Data.Monoid
-import Control.Applicative
-import Data.List
-import Data.CaseInsensitive (mk)
-import qualified Data.ByteString.Char8 as BS
-import qualified Data.ByteString.Lazy.Char8 as LBS
-import Network.HTTP.Types (Status(..), notFound404)
-import Network.HTTP.Conduit
--- import Data.Conduit (ResourceT)
-import qualified Control.Exception as E
-import Data.Maybe (fromMaybe)
-
--- | user/password for HTTP basic access authentication
-data GithubAuth = GithubBasicAuth BS.ByteString BS.ByteString
- | GithubOAuth String
- deriving (Show, Data, Typeable, Eq, Ord)
-
-githubGet :: (FromJSON b, Show b) => [String] -> IO (Either Error b)
-githubGet = githubGet' Nothing
-
-githubGet' :: (FromJSON b, Show b) => Maybe GithubAuth -> [String] -> IO (Either Error b)
-githubGet' auth paths =
- githubAPI (BS.pack "GET")
- (buildUrl paths)
- auth
- (Nothing :: Maybe Value)
-
-githubGetWithQueryString :: (FromJSON b, Show b) => [String] -> String -> IO (Either Error b)
-githubGetWithQueryString = githubGetWithQueryString' Nothing
-
-githubGetWithQueryString' :: (FromJSON b, Show b) => Maybe GithubAuth -> [String] -> String -> IO (Either Error b)
-githubGetWithQueryString' auth paths qs =
- githubAPI (BS.pack "GET")
- (buildUrl paths ++ "?" ++ qs)
- auth
- (Nothing :: Maybe Value)
-
-githubPost :: (ToJSON a, Show a, FromJSON b, Show b) => GithubAuth -> [String] -> a -> IO (Either Error b)
-githubPost auth paths body =
- githubAPI (BS.pack "POST")
- (buildUrl paths)
- (Just auth)
- (Just body)
-
-githubPatch :: (ToJSON a, Show a, FromJSON b, Show b) => GithubAuth -> [String] -> a -> IO (Either Error b)
-githubPatch auth paths body =
- githubAPI (BS.pack "PATCH")
- (buildUrl paths)
- (Just auth)
- (Just body)
-
-buildUrl :: [String] -> String
-buildUrl paths = "https://api.github.com/" ++ intercalate "/" paths
-
-githubAPI :: (ToJSON a, Show a, FromJSON b, Show b) => BS.ByteString -> String
- -> Maybe GithubAuth -> Maybe a -> IO (Either Error b)
-githubAPI apimethod url auth body = do
- result <- doHttps apimethod url auth (encodeBody body)
- case result of
- Left e -> return (Left (HTTPConnectionError e))
- Right resp -> either Left (\x -> jsonResultToE (LBS.pack (show x))
- (fromJSON x))
- <$> handleBody resp
-
- where
- encodeBody = Just . RequestBodyLBS . encode . toJSON
-
- handleBody resp = either (return . Left) (handleJson resp)
- (parseJsonRaw (responseBody resp))
-
- -- This is an "escaping" version of "for", which returns (Right esc) if
- -- the value 'v' is Nothing; otherwise, it extracts the value from the
- -- Maybe, applies f, and return an IO (Either Error b).
- forE :: b -> Maybe a -> (a -> IO (Either Error b))
- -> IO (Either Error b)
- forE = flip . maybe . return . Right
-
- handleJson resp gotjson@(Array ary) =
- -- Determine whether the output was paginated, and if so, we must
- -- recurse to obtain the subsequent pages, and append those result
- -- bodies to the current one. The aggregate will then be parsed.
- forE gotjson (lookup "Link" (responseHeaders resp)) $ \l ->
- forE gotjson (getNextUrl (BS.unpack l)) $ \nu ->
- either (return . Left . HTTPConnectionError)
- (\nextResp -> do
- nextJson <- handleBody nextResp
- return $ (\(Array x) -> Array (ary <> x))
- <$> nextJson)
- =<< doHttps apimethod nu auth Nothing
- handleJson _ gotjson = return (Right gotjson)
-
- getNextUrl l =
- if "rel=\"next\"" `isInfixOf` l
- then let s = l
- s' = Data.List.tail $ Data.List.dropWhile (/= '<') s
- in Just (Data.List.takeWhile (/= '>') s')
- else Nothing
-
-doHttps :: BS.ByteString
- -> [Char]
- -> Maybe GithubAuth
- -> Maybe RequestBody
- -> IO (Either E.SomeException (Response LBS.ByteString))
-doHttps reqMethod url auth body = do
- let reqBody = fromMaybe (RequestBodyBS $ BS.pack "") body
- reqHeaders = maybe [] getOAuth auth
- Just uri = parseUrl url
- request = uri { method = reqMethod
- , secure = True
- , port = 443
- , requestBody = reqBody
- , responseTimeout = Just 20000000
- , requestHeaders = reqHeaders <>
- [("User-Agent", "github.hs/0.7.4")]
- <> [("Accept", "application/vnd.github.preview")]
- , checkStatus = successOrMissing
- }
- authRequest = getAuthRequest auth request
-
- (getResponse authRequest >>= return . Right) `E.catches` [
- -- Re-throw AsyncException, otherwise execution will not terminate on
- -- SIGINT (ctrl-c). All AsyncExceptions are re-thrown (not just
- -- UserInterrupt) because all of them indicate severe conditions and
- -- should not occur during normal operation.
- E.Handler (\e -> E.throw (e :: E.AsyncException)),
- E.Handler (\e -> (return . Left) (e :: E.SomeException))
- ]
- where
- getAuthRequest (Just (GithubBasicAuth user pass)) = applyBasicAuth user pass
- getAuthRequest _ = id
- getOAuth (GithubOAuth token) = [(mk (BS.pack "Authorization"),
- BS.pack ("token " ++ token))]
- getOAuth _ = []
- getResponse request = withManager $ \manager -> httpLbs request manager
-#if MIN_VERSION_http_conduit(1, 9, 0)
- successOrMissing s@(Status sci _) hs cookiejar
-#else
- successOrMissing s@(Status sci _) hs
-#endif
- | (200 <= sci && sci < 300) || sci == 404 = Nothing
-#if MIN_VERSION_http_conduit(1, 9, 0)
- | otherwise = Just $ E.toException $ StatusCodeException s hs cookiejar
-#else
- | otherwise = Just $ E.toException $ StatusCodeException s hs
-#endif
-
-doHttpsStatus :: BS.ByteString -> String -> GithubAuth -> Maybe RequestBody -> IO (Either Error Status)
-doHttpsStatus reqMethod url auth payload = do
- result <- doHttps reqMethod url (Just auth) payload
- case result of
- Left e -> return (Left (HTTPConnectionError e))
- Right resp ->
- let status = responseStatus resp
- headers = responseHeaders resp
- in if status == notFound404
- -- doHttps silently absorbs 404 errors, but for this operation
- -- we want the user to know if they've tried to delete a
- -- non-existent repository
- then return (Left (HTTPConnectionError
- (E.toException
- (StatusCodeException status headers
-#if MIN_VERSION_http_conduit(1, 9, 0)
- (responseCookieJar resp)
-#endif
- ))))
- else return (Right status)
-
-parseJsonRaw :: LBS.ByteString -> Either Error Value
-parseJsonRaw jsonString =
- let parsed = parse json jsonString in
- case parsed of
- Data.Attoparsec.ByteString.Lazy.Done _ jsonResult -> Right jsonResult
- (Fail _ _ e) -> Left $ ParseError e
-
-jsonResultToE :: Show b => LBS.ByteString -> Data.Aeson.Result b
- -> Either Error b
-jsonResultToE jsonString result = case result of
- Success s -> Right s
- Error e -> Left $ JsonError $
- e ++ " on the JSON: " ++ LBS.unpack jsonString
-
-parseJson :: (FromJSON b, Show b) => LBS.ByteString -> Either Error b
-parseJson jsonString = either Left (jsonResultToE jsonString . fromJSON)
- (parseJsonRaw jsonString)
diff --git a/Github/PullRequests.hs b/Github/PullRequests.hs
deleted file mode 100644
--- a/Github/PullRequests.hs
+++ /dev/null
@@ -1,114 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
--- | The pull requests API as documented at
--- .
-module Github.PullRequests (
- pullRequestsFor'
-,pullRequest'
-,pullRequestCommits'
-,pullRequestFiles'
-,pullRequestsFor
-,pullRequest
-,pullRequestCommits
-,pullRequestFiles
-,isPullRequestMerged
-,mergePullRequest
-,createPullRequest
-,updatePullRequest
-,module Github.Data
-) where
-
-import Github.Data
-import Github.Private
-import Network.HTTP.Types
-import qualified Data.Map as M
-import Network.HTTP.Conduit (RequestBody(RequestBodyLBS))
-import Data.Aeson
-
--- | All pull requests for the repo, by owner and repo name.
--- | With authentification
---
--- > pullRequestsFor' (Just ("github-username", "github-password")) "rails" "rails"
-pullRequestsFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [PullRequest])
-pullRequestsFor' auth userName reqRepoName =
- githubGet' auth ["repos", userName, reqRepoName, "pulls"]
-
--- | All pull requests for the repo, by owner and repo name.
---
--- > pullRequestsFor "rails" "rails"
-pullRequestsFor :: String -> String -> IO (Either Error [PullRequest])
-pullRequestsFor = pullRequestsFor' Nothing
-
--- | A detailed pull request, which has much more information. This takes the
--- repo owner and name along with the number assigned to the pull request.
--- | With authentification
---
--- > pullRequest' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 562
-pullRequest' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error DetailedPullRequest)
-pullRequest' auth userName reqRepoName number =
- githubGet' auth ["repos", userName, reqRepoName, "pulls", show number]
-
--- | A detailed pull request, which has much more information. This takes the
--- repo owner and name along with the number assigned to the pull request.
---
--- > pullRequest "thoughtbot" "paperclip" 562
-pullRequest :: String -> String -> Int -> IO (Either Error DetailedPullRequest)
-pullRequest = pullRequest' Nothing
-
--- | All the commits on a pull request, given the repo owner, repo name, and
--- the number of the pull request.
--- | With authentification
---
--- > pullRequestCommits' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688
-pullRequestCommits' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error [Commit])
-pullRequestCommits' auth userName reqRepoName number =
- githubGet' auth ["repos", userName, reqRepoName, "pulls", show number, "commits"]
-
--- | All the commits on a pull request, given the repo owner, repo name, and
--- the number of the pull request.
---
--- > pullRequestCommits "thoughtbot" "paperclip" 688
-pullRequestCommits :: String -> String -> Int -> IO (Either Error [Commit])
-pullRequestCommits = pullRequestCommits' Nothing
-
--- | The individual files that a pull request patches. Takes the repo owner and
--- name, plus the number assigned to the pull request.
--- | With authentification
---
--- > pullRequestFiles' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688
-pullRequestFiles' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error [File])
-pullRequestFiles' auth userName reqRepoName number =
- githubGet' auth ["repos", userName, reqRepoName, "pulls", show number, "files"]
--- | The individual files that a pull request patches. Takes the repo owner and
--- name, plus the number assigned to the pull request.
---
--- > pullRequestFiles "thoughtbot" "paperclip" 688
-pullRequestFiles :: String -> String -> Int -> IO (Either Error [File])
-pullRequestFiles = pullRequestFiles' Nothing
-
--- | Check if pull request has been merged
-isPullRequestMerged :: GithubAuth -> String -> String -> Int -> IO(Either Error Status)
-isPullRequestMerged auth reqRepoOwner reqRepoName reqPullRequestNumber =
- doHttpsStatus "GET" (buildUrl ["repos", reqRepoOwner, reqRepoName, "pulls", (show reqPullRequestNumber), "merge"]) auth Nothing
-
--- | Merge a pull request
-mergePullRequest :: GithubAuth -> String -> String -> Int -> Maybe String -> IO(Either Error Status)
-mergePullRequest auth reqRepoOwner reqRepoName reqPullRequestNumber commitMessage =
- doHttpsStatus "PUT" (buildUrl ["repos", reqRepoOwner, reqRepoName, "pulls", (show reqPullRequestNumber), "merge"]) auth (Just . RequestBodyLBS . encode . toJSON $ (buildCommitMessageMap commitMessage))
-
--- | Update a pull request
-updatePullRequest :: GithubAuth -> String -> String -> Int -> EditPullRequest -> IO (Either Error DetailedPullRequest)
-updatePullRequest auth reqRepoOwner reqRepoName reqPullRequestNumber editPullRequest =
- githubPatch auth ["repos", reqRepoOwner, reqRepoName, "pulls", show reqPullRequestNumber] editPullRequest
-
-
-buildCommitMessageMap :: Maybe String -> M.Map String String
-buildCommitMessageMap (Just commitMessage) = M.singleton "commit_message" commitMessage
-buildCommitMessageMap _ = M.empty
-
-createPullRequest :: GithubAuth
- -> String
- -> String
- -> CreatePullRequest
- -> IO (Either Error DetailedPullRequest)
-createPullRequest auth reqUserName reqRepoName createPR =
- githubPost auth ["repos", reqUserName, reqRepoName, "pulls"] createPR
diff --git a/Github/Repos.hs b/Github/Repos.hs
deleted file mode 100644
--- a/Github/Repos.hs
+++ /dev/null
@@ -1,342 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE CPP #-}
--- | The Github Repos API, as documented at
---
-module Github.Repos (
-
--- * Querying repositories
- userRepos
-,userRepos'
-,userRepo
-,userRepo'
-,organizationRepos
-,organizationRepos'
-,organizationRepo
-,organizationRepo'
-,contributors
-,contributors'
-,contributorsWithAnonymous
-,contributorsWithAnonymous'
-,languagesFor
-,languagesFor'
-,tagsFor
-,tagsFor'
-,branchesFor
-,branchesFor'
-,contentsFor
-,contentsFor'
-,module Github.Data
-,RepoPublicity(..)
-
--- ** Create
-,createRepo
-,createOrganizationRepo
-,newRepo
-,NewRepo(..)
-
--- ** Edit
-,editRepo
-,def
-,Edit(..)
-
--- ** Delete
-,deleteRepo
-) where
-
-import Data.Default
-import Data.Aeson.Types
-import Github.Data
-import Github.Private
-import Network.HTTP.Conduit
-import Control.Applicative
-import qualified Control.Exception as E
-import Network.HTTP.Types
-
--- | Filter the list of the user's repos using any of these constructors.
-data RepoPublicity =
- All -- ^ All repos accessible to the user.
- | Owner -- ^ Only repos owned by the user.
- | Public -- ^ Only public repos.
- | Private -- ^ Only private repos.
- | Member -- ^ Only repos to which the user is a member but not an owner.
- deriving (Show, Eq)
-
--- | The repos for a user, by their login. Can be restricted to just repos they
--- own, are a member of, or publicize. Private repos are currently not
--- supported.
---
--- > userRepos "mike-burns" All
-userRepos :: String -> RepoPublicity -> IO (Either Error [Repo])
-userRepos = userRepos' Nothing
-
--- | The repos for a user, by their login.
--- With authentication, but note that private repos are currently not supported.
---
--- > userRepos' (Just (GithubBasicAuth (user, password))) "mike-burns" All
-userRepos' :: Maybe GithubAuth -> String -> RepoPublicity -> IO (Either Error [Repo])
-userRepos' auth userName All =
- githubGetWithQueryString' auth ["users", userName, "repos"] "type=all"
-userRepos' auth userName Owner =
- githubGetWithQueryString' auth ["users", userName, "repos"] "type=owner"
-userRepos' auth userName Member =
- githubGetWithQueryString' auth ["users", userName, "repos"] "type=member"
-userRepos' auth userName Public =
- githubGetWithQueryString' auth ["users", userName, "repos"] "type=public"
-userRepos' _auth _userName Private =
- return $ Left $ UserError "Cannot access private repos using userRepos"
-
--- | The repos for an organization, by the organization name.
---
--- > organizationRepos "thoughtbot"
-organizationRepos :: String -> IO (Either Error [Repo])
-organizationRepos = organizationRepos' Nothing
-
--- | The repos for an organization, by the organization name.
--- With authentication.
---
--- > organizationRepos (Just (GithubBasicAuth (user, password))) "thoughtbot"
-organizationRepos' :: Maybe GithubAuth -> String -> IO (Either Error [Repo])
-organizationRepos' auth orgName = githubGet' auth ["orgs", orgName, "repos"]
-
--- | A specific organization repo, by the organization name.
---
--- > organizationRepo "thoughtbot" "github"
-organizationRepo :: String -> String -> IO (Either Error Repo)
-organizationRepo = organizationRepo' Nothing
-
--- | A specific organization repo, by the organization name.
--- With authentication.
---
--- > organizationRepo (Just (GithubBasicAuth (user, password))) "thoughtbot" "github"
-organizationRepo' :: Maybe GithubAuth -> String -> String -> IO (Either Error Repo)
-organizationRepo' auth orgName reqRepoName = githubGet' auth ["orgs", orgName, reqRepoName]
-
--- | Details on a specific repo, given the owner and repo name.
---
--- > userRepo "mike-burns" "github"
-userRepo :: String -> String -> IO (Either Error Repo)
-userRepo = userRepo' Nothing
-
--- | Details on a specific repo, given the owner and repo name.
--- With authentication.
---
--- > userRepo' (Just (GithubBasicAuth (user, password))) "mike-burns" "github"
-userRepo' :: Maybe GithubAuth -> String -> String -> IO (Either Error Repo)
-userRepo' auth userName reqRepoName = githubGet' auth ["repos", userName, reqRepoName]
-
--- | The contributors to a repo, given the owner and repo name.
---
--- > contributors "thoughtbot" "paperclip"
-contributors :: String -> String -> IO (Either Error [Contributor])
-contributors = contributors' Nothing
-
--- | The contributors to a repo, given the owner and repo name.
--- With authentication.
---
--- > contributors' (Just (GithubBasicAuth (user, password))) "thoughtbot" "paperclip"
-contributors' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Contributor])
-contributors' auth userName reqRepoName =
- githubGet' auth ["repos", userName, reqRepoName, "contributors"]
-
--- | The contributors to a repo, including anonymous contributors (such as
--- deleted users or git commits with unknown email addresses), given the owner
--- and repo name.
---
--- > contributorsWithAnonymous "thoughtbot" "paperclip"
-contributorsWithAnonymous :: String -> String -> IO (Either Error [Contributor])
-contributorsWithAnonymous = contributorsWithAnonymous' Nothing
-
--- | The contributors to a repo, including anonymous contributors (such as
--- deleted users or git commits with unknown email addresses), given the owner
--- and repo name.
--- With authentication.
---
--- > contributorsWithAnonymous' (Just (GithubBasicAuth (user, password))) "thoughtbot" "paperclip"
-contributorsWithAnonymous' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Contributor])
-contributorsWithAnonymous' auth userName reqRepoName =
- githubGetWithQueryString' auth
- ["repos", userName, reqRepoName, "contributors"]
- "anon=true"
-
-
--- | The programming languages used in a repo along with the number of
--- characters written in that language. Takes the repo owner and name.
---
--- > languagesFor "mike-burns" "ohlaunch"
-languagesFor :: String -> String -> IO (Either Error [Language])
-languagesFor = languagesFor' Nothing
-
--- | The programming languages used in a repo along with the number of
--- characters written in that language. Takes the repo owner and name.
--- With authentication.
---
--- > languagesFor' (Just (GithubBasicAuth (user, password))) "mike-burns" "ohlaunch"
-languagesFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Language])
-languagesFor' auth userName reqRepoName = do
- result <- githubGet' auth ["repos", userName, reqRepoName, "languages"]
- return $ either Left (Right . getLanguages) result
-
--- | The git tags on a repo, given the repo owner and name.
---
--- > tagsFor "thoughtbot" "paperclip"
-tagsFor :: String -> String -> IO (Either Error [Tag])
-tagsFor = tagsFor' Nothing
-
--- | The git tags on a repo, given the repo owner and name.
--- With authentication.
---
--- > tagsFor' (Just (GithubBasicAuth (user, password))) "thoughtbot" "paperclip"
-tagsFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Tag])
-tagsFor' auth userName reqRepoName =
- githubGet' auth ["repos", userName, reqRepoName, "tags"]
-
--- | The git branches on a repo, given the repo owner and name.
---
--- > branchesFor "thoughtbot" "paperclip"
-branchesFor :: String -> String -> IO (Either Error [Branch])
-branchesFor = branchesFor' Nothing
-
--- | The git branches on a repo, given the repo owner and name.
--- With authentication.
---
--- > branchesFor' (Just (GithubBasicAuth (user, password))) "thoughtbot" "paperclip"
-branchesFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Branch])
-branchesFor' auth userName reqRepoName =
- githubGet' auth ["repos", userName, reqRepoName, "branches"]
-
--- | The contents of a file or directory in a repo, given the repo owner, name, and path to the file
---
--- > contentsFor "thoughtbot" "paperclip" "README.md"
-contentsFor :: String -> String -> String -> Maybe String -> IO (Either Error Content)
-contentsFor = contentsFor' Nothing
-
--- | The contents of a file or directory in a repo, given the repo owner, name, and path to the file
--- With Authentication
---
--- > contentsFor' (Just (GithubBasicAuth (user, password))) "thoughtbot" "paperclip" "README.md"
-contentsFor' :: Maybe GithubAuth -> String -> String -> String -> Maybe String -> IO (Either Error Content)
-contentsFor' auth userName reqRepoName reqContentPath ref =
- githubGetWithQueryString' auth
- ["repos", userName, reqRepoName, "contents", reqContentPath] $
- maybe "" ("ref="++) ref
-
-
-data NewRepo = NewRepo {
- newRepoName :: String
-, newRepoDescription :: (Maybe String)
-, newRepoHomepage :: (Maybe String)
-, newRepoPrivate :: (Maybe Bool)
-, newRepoHasIssues :: (Maybe Bool)
-, newRepoHasWiki :: (Maybe Bool)
-, newRepoAutoInit :: (Maybe Bool)
-} deriving Show
-
-instance ToJSON NewRepo where
- toJSON (NewRepo { newRepoName = name
- , newRepoDescription = description
- , newRepoHomepage = homepage
- , newRepoPrivate = private
- , newRepoHasIssues = hasIssues
- , newRepoHasWiki = hasWiki
- , newRepoAutoInit = autoInit
- }) = object
- [ "name" .= name
- , "description" .= description
- , "homepage" .= homepage
- , "private" .= private
- , "has_issues" .= hasIssues
- , "has_wiki" .= hasWiki
- , "auto_init" .= autoInit
- ]
-
-newRepo :: String -> NewRepo
-newRepo name = NewRepo name Nothing Nothing Nothing Nothing Nothing Nothing
-
--- |
--- Create a new repository.
---
--- > createRepo (GithubBasicAuth (user, password)) (newRepo "some_repo") {newRepoHasIssues = Just False}
-createRepo :: GithubAuth -> NewRepo -> IO (Either Error Repo)
-createRepo auth = githubPost auth ["user", "repos"]
-
--- |
--- Create a new repository for an organization.
---
--- > createOrganizationRepo (GithubBasicAuth (user, password)) "thoughtbot" (newRepo "some_repo") {newRepoHasIssues = Just False}
-createOrganizationRepo :: GithubAuth -> String -> NewRepo -> IO (Either Error Repo)
-createOrganizationRepo auth org = githubPost auth ["orgs", org, "repos"]
-
-data Edit = Edit {
- editName :: Maybe String
-, editDescription :: Maybe String
-, editHomepage :: Maybe String
-, editPublic :: Maybe Bool
-, editHasIssues :: Maybe Bool
-, editHasWiki :: Maybe Bool
-, editHasDownloads :: Maybe Bool
-} deriving Show
-
-instance Default Edit where
- def = Edit def def def def def def def
-
-instance ToJSON Edit where
- toJSON (Edit { editName = name
- , editDescription = description
- , editHomepage = homepage
- , editPublic = public
- , editHasIssues = hasIssues
- , editHasWiki = hasWiki
- , editHasDownloads = hasDownloads
- }) = object
- [ "name" .= name
- , "description" .= description
- , "homepage" .= homepage
- , "public" .= public
- , "has_issues" .= hasIssues
- , "has_wiki" .= hasWiki
- , "has_downloads" .= hasDownloads
- ]
-
--- |
--- Edit an existing repository.
---
--- > editRepo (GithubBasicAuth (user, password)) "some_user" "some_repo" def {editDescription = Just "some description"}
-editRepo :: GithubAuth
- -> String -- ^ owner
- -> String -- ^ repository name
- -> Edit
- -> IO (Either Error Repo)
-editRepo auth user repo body = githubPatch auth ["repos", user, repo] b
- where
- -- if no name is given, use curent name
- b = body {editName = editName body <|> Just repo}
-
--- |
--- Delete an existing repository.
---
--- > deleteRepo (GithubBasicAuth (user, password)) "thoughtbot" "some_repo"
-deleteRepo :: GithubAuth
- -> String -- ^ owner
- -> String -- ^ repository name
- -> IO (Either Error ())
-deleteRepo auth owner repo = do
- result <- doHttps "DELETE" url (Just auth) Nothing
- case result of
- Left e -> return (Left (HTTPConnectionError e))
- Right resp ->
- let status = responseStatus resp
- headers = responseHeaders resp
- in if status == notFound404
- -- doHttps silently absorbs 404 errors, but for this operation
- -- we want the user to know if they've tried to delete a
- -- non-existent repository
- then return (Left (HTTPConnectionError
- (E.toException
- (StatusCodeException status headers
-#if MIN_VERSION_http_conduit(1, 9, 0)
- (responseCookieJar resp)
-#endif
- ))))
- else return (Right ())
- where
- url = "https://api.github.com/repos/" ++ owner ++ "/" ++ repo
diff --git a/Github/Repos/Collaborators.hs b/Github/Repos/Collaborators.hs
deleted file mode 100644
--- a/Github/Repos/Collaborators.hs
+++ /dev/null
@@ -1,36 +0,0 @@
--- | The repo collaborators API as described on
--- .
-module Github.Repos.Collaborators (
- collaboratorsOn
-,isCollaboratorOn
-,module Github.Data
-) where
-
-import Github.Data
-import Github.Private
-
-import Data.ByteString.Char8 (pack)
-import qualified Network.HTTP.Conduit as C (responseStatus)
-import qualified Network.HTTP.Types as T (statusCode)
-
--- | All the users who have collaborated on a repo.
---
--- > collaboratorsOn "thoughtbot" "paperclip"
-collaboratorsOn :: String -> String -> IO (Either Error [GithubOwner])
-collaboratorsOn userName reqRepoName =
- githubGet ["repos", userName, reqRepoName, "collaborators"]
-
--- | Whether the user is collaborating on a repo. Takes the user in question,
--- the user who owns the repo, and the repo name.
---
--- > isCollaboratorOn "mike-burns" "thoughtbot" "paperclip"
--- > isCollaboratorOn "johnson" "thoughtbot" "paperclip"
-isCollaboratorOn :: String -> String -> String -> IO (Either Error Bool)
-isCollaboratorOn userName repoOwnerName reqRepoName = do
- result <- doHttps (pack "GET")
- (buildUrl ["repos", repoOwnerName, reqRepoName, "collaborators", userName])
- Nothing
- Nothing
- return $ either (Left . HTTPConnectionError)
- (Right . (204 ==) . T.statusCode . C.responseStatus)
- result
diff --git a/Github/Repos/Commits.hs b/Github/Repos/Commits.hs
deleted file mode 100644
--- a/Github/Repos/Commits.hs
+++ /dev/null
@@ -1,53 +0,0 @@
--- | The repo commits API as described on
--- .
-module Github.Repos.Commits (
- commitsFor
-,commit
-,commentsFor
-,commitCommentsFor
-,commitCommentFor
-,diff
-,module Github.Data
-) where
-
-import Github.Data
-import Github.Private
-
--- | The commit history for a repo.
---
--- > commitsFor "mike-burns" "github"
-commitsFor :: String -> String -> IO (Either Error [Commit])
-commitsFor user repo = githubGet ["repos", user, repo, "commits"]
-
--- | Details on a specific SHA1 for a repo.
---
--- > commit "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81"
-commit :: String -> String -> String -> IO (Either Error Commit)
-commit user repo sha1 = githubGet ["repos", user, repo, "commits", sha1]
-
--- | All the comments on a Github repo.
---
--- > commentsFor "thoughtbot" "paperclip"
-commentsFor :: String -> String -> IO (Either Error [Comment])
-commentsFor user repo = githubGet ["repos", user, repo, "comments"]
-
--- | Just the comments on a specific SHA for a given Github repo.
---
--- > commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b"
-commitCommentsFor :: String -> String -> String -> IO (Either Error [Comment])
-commitCommentsFor user repo sha1 =
- githubGet ["repos", user, repo, "commits", sha1, "comments"]
-
--- | A comment, by its ID, relative to the Github repo.
---
--- > commitCommentFor "thoughtbot" "paperclip" "669575"
-commitCommentFor :: String -> String -> String -> IO (Either Error Comment)
-commitCommentFor user repo reqCommentId =
- githubGet ["repos", user, repo, "comments", reqCommentId]
-
--- | The diff between two treeishes on a repo.
---
--- > diff "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" "HEAD"
-diff :: String -> String -> String -> String -> IO (Either Error Diff)
-diff user repo base headref =
- githubGet ["repos", user, repo, "compare", base ++ "..." ++ headref]
diff --git a/Github/Repos/Forks.hs b/Github/Repos/Forks.hs
deleted file mode 100644
--- a/Github/Repos/Forks.hs
+++ /dev/null
@@ -1,24 +0,0 @@
--- | Hot forking action, as described at
--- .
-module Github.Repos.Forks (
- forksFor
-,forksFor'
-,module Github.Data
-) where
-
-import Github.Data
-import Github.Private
-
--- | All the repos that are forked off the given repo.
---
--- > forksFor "thoughtbot" "paperclip"
-forksFor :: String -> String -> IO (Either Error [Repo])
-forksFor = forksFor' Nothing
-
--- | All the repos that are forked off the given repo.
--- | With authentication
---
--- > forksFor' (Just (GithubUser (user, password))) "thoughtbot" "paperclip"
-forksFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Repo])
-forksFor' auth userName reqRepoName =
- githubGet' auth ["repos", userName, reqRepoName, "forks"]
diff --git a/Github/Repos/Starring.hs b/Github/Repos/Starring.hs
deleted file mode 100644
--- a/Github/Repos/Starring.hs
+++ /dev/null
@@ -1,28 +0,0 @@
--- | The repo starring API as described on
--- .
-module Github.Repos.Starring (
- stargazersFor
-,reposStarredBy
-,myStarred
-,module Github.Data
-) where
-
-import Github.Data
-import Github.Private
-
--- | The list of users that have starred the specified Github repo.
---
--- > userInfoFor' Nothing "mike-burns"
-stargazersFor :: Maybe GithubAuth -> String -> String -> IO (Either Error [GithubOwner])
-stargazersFor auth userName reqRepoName =
- githubGet' auth ["repos", userName, reqRepoName, "stargazers"]
-
--- | All the public repos starred by the specified user.
---
--- > reposStarredBy Nothing "croaky"
-reposStarredBy :: Maybe GithubAuth -> String -> IO (Either Error [Repo])
-reposStarredBy auth userName = githubGet' auth ["users", userName, "starred"]
-
--- | All the repos starred by the authenticated user.
-myStarred :: GithubAuth -> IO (Either Error [Repo])
-myStarred auth = githubGet' (Just auth) ["user", "starred"]
diff --git a/Github/Repos/Subscribing.hs b/Github/Repos/Subscribing.hs
deleted file mode 100644
--- a/Github/Repos/Subscribing.hs
+++ /dev/null
@@ -1,39 +0,0 @@
--- | The repo subscribing API as described on
--- .
-module Github.Repos.Subscribing (
- subscribersFor
-,subscribersFor'
-,reposSubscribedToBy
-,reposSubscribedToBy'
-,module Github.Data
-) where
-
-import Github.Data
-import Github.Private
-
--- | The list of users that are subscribed to the specified Github repo.
---
--- > subscribersFor "thoughtbot" "paperclip"
-subscribersFor :: String -> String -> IO (Either Error [GithubOwner])
-subscribersFor = subscribersFor' Nothing
-
--- | The list of users that are subscribed to the specified Github repo.
--- | With authentication
---
--- > subscribersFor' (Just (GithubUser (user, password))) "thoughtbot" "paperclip"
-subscribersFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [GithubOwner])
-subscribersFor' auth userName reqRepoName =
- githubGet' auth ["repos", userName, reqRepoName, "subscribers"]
-
--- | All the public repos subscribed to by the specified user.
---
--- > reposSubscribedToBy "croaky"
-reposSubscribedToBy :: String -> IO (Either Error [Repo])
-reposSubscribedToBy = reposSubscribedToBy' Nothing
-
--- | All the public repos subscribed to by the specified user.
--- | With authentication
---
--- > reposSubscribedToBy' (Just (GithubUser (user, password))) "croaky"
-reposSubscribedToBy' :: Maybe GithubAuth -> String -> IO (Either Error [Repo])
-reposSubscribedToBy' auth userName = githubGet' auth ["users", userName, "subscriptions"]
diff --git a/Github/Repos/Watching.hs b/Github/Repos/Watching.hs
deleted file mode 100644
--- a/Github/Repos/Watching.hs
+++ /dev/null
@@ -1,39 +0,0 @@
--- | The repo watching API as described on
--- .
-module Github.Repos.Watching (
- watchersFor
-,watchersFor'
-,reposWatchedBy
-,reposWatchedBy'
-,module Github.Data
-) where
-
-import Github.Data
-import Github.Private
-
--- | The list of users that are watching the specified Github repo.
---
--- > watchersFor "thoughtbot" "paperclip"
-watchersFor :: String -> String -> IO (Either Error [GithubOwner])
-watchersFor = watchersFor' Nothing
-
--- | The list of users that are watching the specified Github repo.
--- | With authentication
---
--- > watchersFor' (Just (GithubUser (user, password))) "thoughtbot" "paperclip"
-watchersFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [GithubOwner])
-watchersFor' auth userName reqRepoName =
- githubGet' auth ["repos", userName, reqRepoName, "watchers"]
-
--- | All the public repos watched by the specified user.
---
--- > reposWatchedBy "croaky"
-reposWatchedBy :: String -> IO (Either Error [Repo])
-reposWatchedBy = reposWatchedBy' Nothing
-
--- | All the public repos watched by the specified user.
--- | With authentication
---
--- > reposWatchedBy' (Just (GithubUser (user, password))) "croaky"
-reposWatchedBy' :: Maybe GithubAuth -> String -> IO (Either Error [Repo])
-reposWatchedBy' auth userName = githubGet' auth ["users", userName, "watched"]
diff --git a/Github/Repos/Webhooks.hs b/Github/Repos/Webhooks.hs
deleted file mode 100644
--- a/Github/Repos/Webhooks.hs
+++ /dev/null
@@ -1,116 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE CPP #-}
--- | The webhooks API, as described at
---
---
-
-module Github.Repos.Webhooks (
-
--- * Querying repositories
- webhooksFor'
- ,webhookFor'
-
--- ** Create
- ,createRepoWebhook'
-
--- ** Edit
- ,editRepoWebhook'
-
--- ** Test
- ,testPushRepoWebhook'
- ,pingRepoWebhook'
-
--- ** Delete
- ,deleteRepoWebhook'
- ,NewRepoWebhook(..)
- ,EditRepoWebhook(..)
- ,RepoOwner
- ,RepoName
- ,RepoWebhookId
-) where
-
-import Github.Data
-import Github.Private
-import qualified Data.Map as M
-import Network.HTTP.Conduit
-import Network.HTTP.Types
-import Data.Aeson
-
-type RepoOwner = String
-type RepoName = String
-type RepoWebhookId = Int
-
-data NewRepoWebhook = NewRepoWebhook {
- newRepoWebhookName :: String
- ,newRepoWebhookConfig :: M.Map String String
- ,newRepoWebhookEvents :: Maybe [RepoWebhookEvent]
- ,newRepoWebhookActive :: Maybe Bool
-} deriving Show
-
-data EditRepoWebhook = EditRepoWebhook {
- editRepoWebhookConfig :: Maybe (M.Map String String)
- ,editRepoWebhookEvents :: Maybe [RepoWebhookEvent]
- ,editRepoWebhookAddEvents :: Maybe [RepoWebhookEvent]
- ,editRepoWebhookRemoveEvents :: Maybe [RepoWebhookEvent]
- ,editRepoWebhookActive :: Maybe Bool
-} deriving Show
-
-instance ToJSON NewRepoWebhook where
- toJSON (NewRepoWebhook { newRepoWebhookName = name
- , newRepoWebhookConfig = config
- , newRepoWebhookEvents = events
- , newRepoWebhookActive = active
-
- }) = object
- [ "name" .= name
- , "config" .= config
- , "events" .= events
- , "active" .= active
- ]
-
-instance ToJSON EditRepoWebhook where
- toJSON (EditRepoWebhook { editRepoWebhookConfig = config
- , editRepoWebhookEvents = events
- , editRepoWebhookAddEvents = addEvents
- , editRepoWebhookRemoveEvents = removeEvents
- , editRepoWebhookActive = active
- }) = object
- [ "config" .= config
- , "events" .= events
- , "add_events" .= addEvents
- , "remove_events" .= removeEvents
- , "active" .= active
- ]
-
-webhooksFor' :: GithubAuth -> RepoOwner -> RepoName -> IO (Either Error [RepoWebhook])
-webhooksFor' auth owner reqRepoName =
- githubGet' (Just auth) ["repos", owner, reqRepoName, "hooks"]
-
-webhookFor' :: GithubAuth -> RepoOwner -> RepoName -> RepoWebhookId -> IO (Either Error RepoWebhook)
-webhookFor' auth owner reqRepoName webhookId =
- githubGet' (Just auth) ["repos", owner, reqRepoName, "hooks", (show webhookId)]
-
-createRepoWebhook' :: GithubAuth -> RepoOwner -> RepoName -> NewRepoWebhook -> IO (Either Error RepoWebhook)
-createRepoWebhook' auth owner reqRepoName = githubPost auth ["repos", owner, reqRepoName, "hooks"]
-
-editRepoWebhook' :: GithubAuth -> RepoOwner -> RepoName -> RepoWebhookId -> EditRepoWebhook -> IO (Either Error RepoWebhook)
-editRepoWebhook' auth owner reqRepoName webhookId edit = githubPatch auth ["repos", owner, reqRepoName, "hooks", (show webhookId)] edit
-
-testPushRepoWebhook' :: GithubAuth -> RepoOwner -> RepoName -> RepoWebhookId -> IO (Either Error Status)
-testPushRepoWebhook' auth owner reqRepoName webhookId =
- doHttpsStatus "POST" (createWebhookOpUrl owner reqRepoName webhookId (Just "tests")) auth (Just . RequestBodyLBS . encode $ (decode "{}" :: Maybe (M.Map String Int)))
-
-pingRepoWebhook' :: GithubAuth -> RepoOwner -> RepoName -> RepoWebhookId -> IO (Either Error Status)
-pingRepoWebhook' auth owner reqRepoName webhookId =
- doHttpsStatus "POST" (createWebhookOpUrl owner reqRepoName webhookId (Just "pings")) auth Nothing
-
-deleteRepoWebhook' :: GithubAuth -> RepoOwner -> RepoName -> RepoWebhookId -> IO (Either Error Status)
-deleteRepoWebhook' auth owner reqRepoName webhookId =
- doHttpsStatus "DELETE" (createWebhookOpUrl owner reqRepoName webhookId Nothing) auth Nothing
-
-createBaseWebhookUrl :: RepoOwner -> RepoName -> RepoWebhookId -> String
-createBaseWebhookUrl owner reqRepoName webhookId = "https://api.github.com/repos/" ++ owner ++ "/" ++ reqRepoName ++ "/hooks/" ++ (show webhookId)
-
-createWebhookOpUrl :: RepoOwner -> RepoName -> RepoWebhookId -> Maybe String -> String
-createWebhookOpUrl owner reqRepoName webhookId Nothing = createBaseWebhookUrl owner reqRepoName webhookId
-createWebhookOpUrl owner reqRepoName webhookId (Just operation) = createBaseWebhookUrl owner reqRepoName webhookId ++ "/" ++ operation
diff --git a/Github/Repos/Webhooks/Validate.hs b/Github/Repos/Webhooks/Validate.hs
deleted file mode 100644
--- a/Github/Repos/Webhooks/Validate.hs
+++ /dev/null
@@ -1,35 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
--- | Verification of incomming webhook payloads, as described at
---
-
-module Github.Repos.Webhooks.Validate (
- isValidPayload
-) where
-
-import Control.Applicative
-import Crypto.Hash
-import qualified Data.ByteString.Char8 as BS
-import Data.Byteable (constEqBytes, toBytes)
-import qualified Data.ByteString.Base16 as Hex
-import Data.Monoid
-
-
--- | Validates a given payload against a given HMAC hexdigest using a given
--- secret.
--- Returns 'True' iff the given hash is non-empty and it's a valid signature of
--- the payload.
-isValidPayload
- :: String -- ^ the secret
- -> Maybe String -- ^ the hash provided by the remote party
- -- in @X-Hub-Signature@ (if any),
- -- including the 'sha1=...' prefix
- -> BS.ByteString -- ^ the body
- -> Bool
-isValidPayload secret shaOpt payload = maybe False (constEqBytes sign) shaOptBS
- where
- shaOptBS = BS.pack <$> shaOpt
- hexDigest = Hex.encode . toBytes . hmacGetDigest
-
- hm = hmac (BS.pack secret) payload :: HMAC SHA1
- sign = "sha1=" <> hexDigest hm
diff --git a/Github/Search.hs b/Github/Search.hs
deleted file mode 100644
--- a/Github/Search.hs
+++ /dev/null
@@ -1,42 +0,0 @@
--- | The Github Search API, as described at
--- .
-module Github.Search(
- searchRepos'
-,searchRepos
-,searchCode'
-,searchCode
-,module Github.Data
-) where
-
-import Github.Data
-import Github.Private
-
--- | Perform a repository search.
--- | With authentication.
---
--- > searchRepos' (Just $ GithubBasicAuth "github-username" "github-password') "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100"
-searchRepos' :: Maybe GithubAuth -> String -> IO (Either Error SearchReposResult)
-searchRepos' auth queryString = githubGetWithQueryString' auth ["search", "repositories"] queryString
-
--- | Perform a repository search.
--- | Without authentication.
---
--- > searchRepos "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100"
-searchRepos :: String -> IO (Either Error SearchReposResult)
-searchRepos = searchRepos' Nothing
-
--- | Perform a code search.
--- | With authentication.
---
--- > searchCode' (Just $ GithubBasicAuth "github-username" "github-password') "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100"
-searchCode' :: Maybe GithubAuth -> String -> IO (Either Error SearchCodeResult)
-searchCode' auth queryString = githubGetWithQueryString' auth ["search", "code"] queryString
-
--- | Perform a code search.
--- | Without authentication.
---
--- > searchCode "q=addClass+in:file+language:js+repo:jquery/jquery"
-searchCode :: String -> IO (Either Error SearchCodeResult)
-searchCode = searchCode' Nothing
-
-
diff --git a/Github/Users.hs b/Github/Users.hs
deleted file mode 100644
--- a/Github/Users.hs
+++ /dev/null
@@ -1,23 +0,0 @@
--- | The Github Users API, as described at
--- .
-module Github.Users (
- userInfoFor
-,userInfoFor'
-,module Github.Data
-) where
-
-import Github.Data
-import Github.Private
-
--- | The information for a single user, by login name.
--- | With authentification
---
--- > userInfoFor' (Just ("github-username", "github-password")) "mike-burns"
-userInfoFor' :: Maybe GithubAuth -> String -> IO (Either Error DetailedOwner)
-userInfoFor' auth userName = githubGet' auth ["users", userName]
-
--- | The information for a single user, by login name.
---
--- > userInfoFor "mike-burns"
-userInfoFor :: String -> IO (Either Error DetailedOwner)
-userInfoFor = userInfoFor' Nothing
diff --git a/Github/Users/Followers.hs b/Github/Users/Followers.hs
deleted file mode 100644
--- a/Github/Users/Followers.hs
+++ /dev/null
@@ -1,22 +0,0 @@
--- | The user followers API as described on
--- .
-module Github.Users.Followers (
- usersFollowing
-,usersFollowedBy
-,module Github.Data
-) where
-
-import Github.Data
-import Github.Private
-
--- | All the users following the given user.
---
--- > usersFollowing "mike-burns"
-usersFollowing :: String -> IO (Either Error [GithubOwner])
-usersFollowing userName = githubGet ["users", userName, "followers"]
-
--- | All the users that the given user follows.
---
--- > usersFollowedBy "mike-burns"
-usersFollowedBy :: String -> IO (Either Error [GithubOwner])
-usersFollowedBy userName = githubGet ["users", userName, "following"]
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -12,12 +12,16 @@
In your project's cabal file:
- -- Packages needed in order to build this package.
- Build-depends: github
+```cabal
+-- Packages needed in order to build this package.
+Build-depends: github
+```
Or from the command line:
- cabal install github
+```sh
+cabal install github
+```
Example Usage
=============
@@ -33,23 +37,39 @@
Each module lines up with the hierarchy of
[documentation from the Github API](http://developer.github.com/v3/).
-Each function has a sample written for it.
+Request functions (ending with `R`) construct a data type with can be executed
+in `IO` by `executeRequest` functions. They are all listed in the root `GitHub`
+module.
-All functions produce an `IO (Either Error a)`, where `a` is the actual thing
+IO functions produce an `IO (Either Error a)`, where `a` is the actual thing
you want. You must call the function using IO goodness, then dispatch on the
possible error message. Here's an example from the samples:
- import qualified Github.Users.Followers as Github
- import Data.List (intercalate)
+Many function have samples under
+[`samples/`](https://github.com/phadej/github/tree/master/samples) directory.
- main = do
- possibleUsers <- Github.usersFollowing "mike-burns"
- putStrLn $ either (("Error: "++) . show)
- (intercalate "\n" . map formatUser)
+```hs
+import qualified GitHub.Endpoints.Users.Followers as Github
+
+main = do
+ possibleUsers <- GitHub.usersFollowing "mike-burns"
+ T.putStrLn $ either (("Error: " <>) . T.pack . show)
+ (foldMap (formatUser . (<> "\n")))
possibleUsers
- formatUser = Github.githubOwnerLogin
+formatUser = GitHub.untagName . GitHub.githubOwnerLogin
+```
+Test setup
+==========
+
+To run integration part of tests, you'll need [github access token](https://github.com/settings/tokens/new)
+Token is needed, because unauthorised access is highly limited.
+It's enough to add only basic read access for public information.
+
+With `travis encrypt --org --repo yournick/github "GITHUB_TOKEN=yourtoken"` command you get a secret,
+you can use in your travis setup to run the test-suite there.
+
Contributions
=============
@@ -60,7 +80,8 @@
Copyright
=========
-Copyright 2011, 2012 Mike Burns.
-Copyright 2013-2014 John Wiegley.
+Copyright 2011-2012 Mike Burns.
+Copyright 2013-2015 John Wiegley.
+Copyright 2016 Oleg Grenrus.
Available under the BSD 3-clause license.
diff --git a/fixtures/issue-search.json b/fixtures/issue-search.json
new file mode 100644
--- /dev/null
+++ b/fixtures/issue-search.json
@@ -0,0 +1,96 @@
+{
+ "total_count": 2,
+ "incomplete_results": false,
+ "items": [
+ {
+ "url": "https://api.github.com/repos/phadej/github/issues/130",
+ "labels_url": "https://api.github.com/repos/phadej/github/issues/130/labels{/name}",
+ "comments_url": "https://api.github.com/repos/phadej/github/issues/130/comments",
+ "events_url": "https://api.github.com/repos/phadej/github/issues/130/events",
+ "html_url": "https://github.com/phadej/github/pull/130",
+ "id": 123898390,
+ "number": 130,
+ "title": "Make test runner more robust",
+ "user": {
+ "login": "phadej",
+ "id": 51087,
+ "avatar_url": "https://avatars.githubusercontent.com/u/51087?v=3",
+ "gravatar_id": "",
+ "url": "https://api.github.com/users/phadej",
+ "html_url": "https://github.com/phadej",
+ "followers_url": "https://api.github.com/users/phadej/followers",
+ "following_url": "https://api.github.com/users/phadej/following{/other_user}",
+ "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}",
+ "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}",
+ "subscriptions_url": "https://api.github.com/users/phadej/subscriptions",
+ "organizations_url": "https://api.github.com/users/phadej/orgs",
+ "repos_url": "https://api.github.com/users/phadej/repos",
+ "events_url": "https://api.github.com/users/phadej/events{/privacy}",
+ "received_events_url": "https://api.github.com/users/phadej/received_events",
+ "type": "User",
+ "site_admin": false
+ },
+ "labels": [
+
+ ],
+ "state": "closed",
+ "locked": false,
+ "assignee": null,
+ "milestone": null,
+ "comments": 0,
+ "created_at": "2015-12-25T21:37:39Z",
+ "updated_at": "2015-12-26T08:57:52Z",
+ "closed_at": "2015-12-25T23:32:12Z",
+ "pull_request": {
+ "url": "https://api.github.com/repos/phadej/github/pulls/130",
+ "html_url": "https://github.com/phadej/github/pull/130",
+ "diff_url": "https://github.com/phadej/github/pull/130.diff",
+ "patch_url": "https://github.com/phadej/github/pull/130.patch"
+ },
+ "body": "As they use access token, it's highly unlikely it will be rate limited. ATM there's only one request per test job. i.e. travis could be re-enabled.\r\n\r\nExample run https://travis-ci.org/phadej/github/builds/98815089\r\nSome tests are pending as secret is made for this `jwiegley/github` repository.",
+ "score": 0.75566536
+ },
+ {
+ "url": "https://api.github.com/repos/phadej/github/issues/127",
+ "labels_url": "https://api.github.com/repos/phadej/github/issues/127/labels{/name}",
+ "comments_url": "https://api.github.com/repos/phadej/github/issues/127/comments",
+ "events_url": "https://api.github.com/repos/phadej/github/issues/127/events",
+ "html_url": "https://github.com/phadej/github/issues/127",
+ "id": 119694665,
+ "number": 127,
+ "title": "Decouple request creation from execution",
+ "user": {
+ "login": "phadej",
+ "id": 51087,
+ "avatar_url": "https://avatars.githubusercontent.com/u/51087?v=3",
+ "gravatar_id": "",
+ "url": "https://api.github.com/users/phadej",
+ "html_url": "https://github.com/phadej",
+ "followers_url": "https://api.github.com/users/phadej/followers",
+ "following_url": "https://api.github.com/users/phadej/following{/other_user}",
+ "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}",
+ "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}",
+ "subscriptions_url": "https://api.github.com/users/phadej/subscriptions",
+ "organizations_url": "https://api.github.com/users/phadej/orgs",
+ "repos_url": "https://api.github.com/users/phadej/repos",
+ "events_url": "https://api.github.com/users/phadej/events{/privacy}",
+ "received_events_url": "https://api.github.com/users/phadej/received_events",
+ "type": "User",
+ "site_admin": false
+ },
+ "labels": [
+
+ ],
+ "state": "open",
+ "locked": false,
+ "assignee": null,
+ "milestone": null,
+ "comments": 2,
+ "created_at": "2015-12-01T11:09:03Z",
+ "updated_at": "2015-12-25T19:15:33Z",
+ "closed_at": null,
+ "body": "After working with this API, and making few others, I found that separating request creation and execution is better (i.e. more flexible) design.\r\n\r\nNow one cannot use different network client or add new endpoints.\r\n\r\nShorly\r\n\r\n```hs\r\n-- New stuff:\r\ndata GithubRequest a = GithubRequestGet Url\r\n | ...\r\n\r\n-- or alternatively\r\ndata GithubRequest a where\r\n GithubRequestGet :: Url -> GithubRequest a\r\n GithubRequestMultiGet :: Url -> GithubRequest [a]\r\n\r\nexecGithubRequest :: FromJSON a => GithubRequest a -> IO (Either Error a)\r\nexecGithubRequest' :: FromJSON a => Maybe GithubAuth -> GithubRequest a -> IO (Either Error a)\r\n\r\npublicOrganizationForRequest :: String -> GithubRequest [SimpleOrganisation]\r\npublicOrganizationForRequest org = GithubRequestGet ...\r\n\r\n-- Old IO methods become:\r\npublicOrganizationsFor :: String -> IO (Either Error [SimpleOrganization])\r\npublicOrganizationsFor = execGithubRequest . publicOrganizationForRequest\r\n\r\npublicOrganizationsFor' :: Maybe GithubAuth -> String -> IO (Either Error [SimpleOrganization])\r\npublicOrganizationsFor' auth = execGithubRequest' auth . publicOrganizationForRequest\r\n```\r\n\r\nHow does this sound? I can make a refactoring, it's quite straight-forward.",
+ "score": 0.7265285
+ }
+ ]
+}
diff --git a/fixtures/list-teams.json b/fixtures/list-teams.json
new file mode 100644
--- /dev/null
+++ b/fixtures/list-teams.json
@@ -0,0 +1,13 @@
+[
+ {
+ "id": 1,
+ "url": "https://api.github.com/teams/1",
+ "name": "Justice League",
+ "slug": "justice-league",
+ "description": "A great team.",
+ "privacy": "closed",
+ "permission": "admin",
+ "members_url": "https://api.github.com/teams/1/members{/member}",
+ "repositories_url": "https://api.github.com/teams/1/repos"
+ }
+]
diff --git a/fixtures/members-list.json b/fixtures/members-list.json
new file mode 100644
--- /dev/null
+++ b/fixtures/members-list.json
@@ -0,0 +1,21 @@
+[
+ {
+ "login": "octocat",
+ "id": 1,
+ "avatar_url": "https://github.com/images/error/octocat_happy.gif",
+ "gravatar_id": "",
+ "url": "https://api.github.com/users/octocat",
+ "html_url": "https://github.com/octocat",
+ "followers_url": "https://api.github.com/users/octocat/followers",
+ "following_url": "https://api.github.com/users/octocat/following{/other_user}",
+ "gists_url": "https://api.github.com/users/octocat/gists{/gist_id}",
+ "starred_url": "https://api.github.com/users/octocat/starred{/owner}{/repo}",
+ "subscriptions_url": "https://api.github.com/users/octocat/subscriptions",
+ "organizations_url": "https://api.github.com/users/octocat/orgs",
+ "repos_url": "https://api.github.com/users/octocat/repos",
+ "events_url": "https://api.github.com/users/octocat/events{/privacy}",
+ "received_events_url": "https://api.github.com/users/octocat/received_events",
+ "type": "User",
+ "site_admin": false
+ }
+]
diff --git a/fixtures/user-organizations.json b/fixtures/user-organizations.json
new file mode 100644
--- /dev/null
+++ b/fixtures/user-organizations.json
@@ -0,0 +1,9 @@
+[
+ {
+ "login": "github",
+ "id": 1,
+ "url": "https://api.github.com/orgs/github",
+ "avatar_url": "https://github.com/images/error/octocat_happy.gif",
+ "description": "A great organization"
+ }
+]
diff --git a/fixtures/user.json b/fixtures/user.json
new file mode 100644
--- /dev/null
+++ b/fixtures/user.json
@@ -0,0 +1,32 @@
+{
+ "login": "mike-burns",
+ "id": 4550,
+ "avatar_url": "https://avatars.githubusercontent.com/u/4550?v=3",
+ "gravatar_id": "",
+ "url": "https://api.github.com/users/mike-burns",
+ "html_url": "https://github.com/mike-burns",
+ "followers_url": "https://api.github.com/users/mike-burns/followers",
+ "following_url": "https://api.github.com/users/mike-burns/following{/other_user}",
+ "gists_url": "https://api.github.com/users/mike-burns/gists{/gist_id}",
+ "starred_url": "https://api.github.com/users/mike-burns/starred{/owner}{/repo}",
+ "subscriptions_url": "https://api.github.com/users/mike-burns/subscriptions",
+ "organizations_url": "https://api.github.com/users/mike-burns/orgs",
+ "repos_url": "https://api.github.com/users/mike-burns/repos",
+ "events_url": "https://api.github.com/users/mike-burns/events{/privacy}",
+ "received_events_url": "https://api.github.com/users/mike-burns/received_events",
+ "type": "User",
+ "site_admin": false,
+ "name": "Mike Burns",
+ "company": "thoughtbot",
+ "blog": "http://mike-burns.com/",
+ "location": "Stockholm, Sweden",
+ "email": "mburns@thoughtbot.com",
+ "hireable": true,
+ "bio": null,
+ "public_repos": 35,
+ "public_gists": 32,
+ "followers": 171,
+ "following": 0,
+ "created_at": "2008-04-03T17:54:24Z",
+ "updated_at": "2015-10-02T16:53:25Z"
+}
diff --git a/github.cabal b/github.cabal
--- a/github.cabal
+++ b/github.cabal
@@ -1,219 +1,160 @@
--- github.cabal auto-generated by cabal init. For additional options,
--- see
--- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.
--- The name of the package.
-Name: github
-
--- The package version. See the Haskell package versioning policy
--- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for
--- standards guiding when and how versions should be incremented.
-Version: 0.13.2
-
--- A short (one-line) description of the package.
-Synopsis: Access to the Github API, v3.
-
--- A longer description of the package.
-Description: The Github API provides programmatic access to the full
- Github Web site, from Issues to Gists to repos down to the underlying git data
- like references and trees. This library wraps all of that, exposing a basic but
- Haskell-friendly set of functions and data structures.
- .
- For more of an overview please see the README:
-
--- The license under which the package is released.
-License: BSD3
-
--- The file containing the license text.
-License-file: LICENSE
-
--- The package author(s).
-Author: Mike Burns, John Wiegley
-
--- An email address to which users can send suggestions, bug reports,
--- and patches.
-Maintainer: johnw@newartisans.com
-
-Homepage: https://github.com/jwiegley/github
-
--- A copyright notice.
-Copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley
-
-Category: Network APIs
-
-Build-type: Simple
-
--- Extra files to be distributed with the package, such as examples or
--- a README.
-Extra-source-files: README.md
- ,samples/Gists/Comments/ShowComment.hs
- ,samples/Gists/Comments/ShowComments.hs
- ,samples/Gists/ListGists.hs
- ,samples/Gists/ShowGist.hs
- ,samples/GitData/Commits/GitShow.hs
- ,samples/GitData/References/GitCreateReference.hs
- ,samples/GitData/References/GitLsRemote.hs
- ,samples/GitData/References/GitLsRemoteTags.hs
- ,samples/GitData/References/GitLsRemoteWithRef.hs
- ,samples/GitData/Trees/GitLsTree.hs
- ,samples/GitData/Trees/GitLsTreeRecursively.hs
- ,samples/Issues/Comments/ShowComment.hs
- ,samples/Issues/Comments/ShowComments.hs
- ,samples/Issues/Events/ShowEvent.hs
- ,samples/Issues/Events/ShowIssueEvents.hs
- ,samples/Issues/Events/ShowRepoEvents.hs
- ,samples/Issues/Labels/ShowIssueLabels.hs
- ,samples/Issues/Labels/ShowLabel.hs
- ,samples/Issues/Labels/ShowMilestoneLabels.hs
- ,samples/Issues/Labels/ShowRepoLabels.hs
- ,samples/Issues/Milestones/ShowMilestone.hs
- ,samples/Issues/Milestones/ShowMilestones.hs
- ,samples/Issues/ShowIssue.hs
- ,samples/Issues/ShowRepoIssues.hs
- ,samples/Organizations/Members/ShowMembers.hs
- ,samples/Organizations/ShowPublicOrganization.hs
- ,samples/Organizations/ShowPublicOrganizations.hs
- ,samples/Pulls/Diff.hs
- ,samples/Pulls/ListPulls.hs
- ,samples/Pulls/ReviewComments/ListComments.hs
- ,samples/Pulls/ReviewComments/ShowComment.hs
- ,samples/Pulls/ShowCommits.hs
- ,samples/Pulls/ShowPull.hs
- ,samples/Search/SearchRepos.hs
- ,samples/Repos/Collaborators/IsCollaborator.hs
- ,samples/Repos/Collaborators/ListCollaborators.hs
- ,samples/Repos/Commits/CommitComment.hs
- ,samples/Repos/Commits/CommitComments.hs
- ,samples/Repos/Commits/GitDiff.hs
- ,samples/Repos/Commits/GitLog.hs
- ,samples/Repos/Commits/GitShow.hs
- ,samples/Repos/Commits/RepoComments.hs
- ,samples/Repos/Forks/ListForks.hs
- ,samples/Repos/ListBranches.hs
- ,samples/Repos/ListContributors.hs
- ,samples/Repos/ListContributorsWithAnonymous.hs
- ,samples/Repos/ListLanguages.hs
- ,samples/Repos/ListOrgRepos.hs
- ,samples/Repos/ListTags.hs
- ,samples/Repos/ListUserRepos.hs
- ,samples/Repos/ShowRepo.hs
- ,samples/Repos/Watching/ListWatched.hs
- ,samples/Repos/Watching/ListWatchers.hs
- ,samples/Repos/Starring/ListStarred.hs
- ,samples/Repos/Webhooks/CreateWebhook.hs
- ,samples/Repos/Webhooks/DeleteWebhook.hs
- ,samples/Repos/Webhooks/EditWebhook.hs
- ,samples/Repos/Webhooks/ListWebhook.hs
- ,samples/Repos/Webhooks/ListWebhooks.hs
- ,samples/Repos/Webhooks/PingWebhook.hs
- ,samples/Repos/Webhooks/TestPushWebhook.hs
- ,samples/Users/Followers/ListFollowers.hs
- ,samples/Users/Followers/ListFollowing.hs
- ,samples/Users/ShowUser.hs
- ,LICENSE
-
+name: github
+version: 0.14.0
+synopsis: Access to the GitHub API, v3.
+description:
+ The GitHub API provides programmatic access to the full
+ GitHub Web site, from Issues to Gists to repos down to the underlying git data
+ like references and trees. This library wraps all of that, exposing a basic but
+ Haskell-friendly set of functions and data structures.
+ .
+ For supported endpoints see "GitHub" module.
+ .
+ > import qualified GitHub as GH
+ >
+ > main :: IO ()
+ > main = do
+ > possibleUser <- GH.executeRequest' $ GH.userInfoR "phadej"
+ > print possibleUser
+ .
+ For more of an overview please see the README:
+license: BSD3
+license-file: LICENSE
+author: Mike Burns, John Wiegley, Oleg Grenrus
+maintainer: Oleg Grenrus
+homepage: https://github.com/phadej/github
+copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016 Oleg Grenrus
+category: Network
+build-type: Simple
+tested-with: GHC==7.8.4, GHC==7.10.2
+cabal-version: >=1.10
+extra-source-files:
+ README.md,
+ fixtures/issue-search.json,
+ fixtures/list-teams.json,
+ fixtures/members-list.json,
+ fixtures/user-organizations.json,
+ fixtures/user.json
--- Constraint on the version of Cabal needed to build this package.
-Cabal-version: >=1.10
+flag aeson-compat
+ description: Whether to use aeson-compat or aeson-extra
+ default: True
+ manual: False
source-repository head
type: git
- location: git://github.com/jwiegley/github.git
+ location: git://github.com/phadej/github.git
Library
- -- Modules exported by the library.
- Default-Language: Haskell2010
- Exposed-modules: Github.Auth,
- Github.Data,
- Github.Data.Definitions,
- Github.Events,
- Github.Gists,
- Github.Gists.Comments,
- Github.GitData.Commits,
- Github.GitData.References,
- Github.GitData.Trees,
- Github.GitData.Blobs,
- Github.Issues,
- Github.Issues.Comments,
- Github.Issues.Events,
- Github.Issues.Labels,
- Github.Issues.Milestones,
- Github.Organizations,
- Github.Organizations.Members,
- Github.PullRequests,
- Github.Repos,
- Github.Repos.Collaborators,
- Github.Repos.Commits,
- Github.Repos.Forks,
- Github.Repos.Watching,
- Github.Repos.Starring,
- Github.Repos.Subscribing,
- Github.Repos.Webhooks
- Github.Repos.Webhooks.Validate,
- Github.Users,
- Github.Users.Followers
- Github.Search
+ default-language: Haskell2010
+ ghc-options: -Wall
+ hs-source-dirs: src
+ exposed-modules:
+ GitHub
+ GitHub.Auth
+ GitHub.Data
+ GitHub.Data.Comments
+ GitHub.Data.Content
+ GitHub.Data.Definitions
+ GitHub.Data.Gists
+ GitHub.Data.GitData
+ GitHub.Data.Id
+ GitHub.Data.Issues
+ GitHub.Data.Name
+ GitHub.Data.PullRequests
+ GitHub.Data.Repos
+ GitHub.Data.Request
+ GitHub.Data.Search
+ GitHub.Data.Teams
+ GitHub.Data.Webhooks
+ GitHub.Data.Webhooks.Validate
+ GitHub.Endpoints.Activity.Starring
+ GitHub.Endpoints.Activity.Watching
+ GitHub.Endpoints.Gists
+ GitHub.Endpoints.Gists.Comments
+ GitHub.Endpoints.GitData.Blobs
+ GitHub.Endpoints.GitData.Commits
+ GitHub.Endpoints.GitData.References
+ GitHub.Endpoints.GitData.Trees
+ GitHub.Endpoints.Issues
+ GitHub.Endpoints.Issues.Comments
+ GitHub.Endpoints.Issues.Events
+ GitHub.Endpoints.Issues.Labels
+ GitHub.Endpoints.Issues.Milestones
+ GitHub.Endpoints.Organizations
+ GitHub.Endpoints.Organizations.Members
+ GitHub.Endpoints.Organizations.Teams
+ GitHub.Endpoints.PullRequests
+ GitHub.Endpoints.PullRequests.ReviewComments
+ GitHub.Endpoints.Repos
+ GitHub.Endpoints.Repos.Collaborators
+ GitHub.Endpoints.Repos.Comments
+ GitHub.Endpoints.Repos.Commits
+ GitHub.Endpoints.Repos.Forks
+ GitHub.Endpoints.Repos.Webhooks
+ GitHub.Endpoints.Search
+ GitHub.Endpoints.Users
+ GitHub.Endpoints.Users.Followers
+ GitHub.Request
-- Packages needed in order to build this package.
- Build-depends: base >= 4.0 && < 5.0,
- time,
- aeson >= 0.6.1.0,
- attoparsec >= 0.10.3.0,
- bytestring,
- case-insensitive >= 0.4.0.4,
- containers,
- hashable,
- text,
- old-locale,
- HTTP,
- network,
- http-conduit >= 1.8,
- conduit,
- failure,
- http-types,
- data-default,
- vector,
- unordered-containers >= 0.2 && < 0.3,
- cryptohash >= 0.11,
- byteable >= 0.1.0,
- base16-bytestring >= 0.1.1.6
-
- -- Modules not exported by this package.
- Other-modules: Github.Private
-
- -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.
- -- Build-tools:
-
- GHC-Options: -Wall -fno-warn-orphans
+ build-depends: base >= 4.7 && <4.9,
+ aeson >=0.7.0.6 && <0.11,
+ attoparsec >=0.11.3.4 && <0.14,
+ base-compat >=0.6.0 && <0.10,
+ base16-bytestring >=0.1.1.6 && <0.2,
+ binary >=0.7.1.0 && <0.9,
+ binary-orphans >=0.1.0.0 && <0.2,
+ byteable >=0.1.1 && <0.2,
+ bytestring >=0.10.4.0 && <0.11,
+ containers >=0.5.5.1 && <0.6,
+ cryptohash >=0.11 && <0.12,
+ deepseq >=1.3.0.2 && <1.5,
+ deepseq-generics >=0.1.1.2 && <0.3,
+ exceptions >=0.8.0.2 && <0.9,
+ hashable >=1.2.3.3 && <1.3,
+ http-client >=0.4.8.1 && <0.5,
+ http-client-tls >=0.2.2 && <0.3,
+ http-link-header >=1.0.1 && <1.1,
+ http-types >=0.8.6 && <0.10,
+ iso8601-time >=0.1.4 && <0.2,
+ mtl >=2.1.3.1 && <2.3,
+ network-uri >=2.6.0.3 && <2.7,
+ semigroups >=0.16.2.2 && <0.19,
+ text >=1.2.0.6 && <1.3,
+ time >=1.4 && <1.7,
+ transformers >=0.3.0.0 && <0.6,
+ transformers-compat >=0.4.0.3 && <0.6,
+ unordered-containers >=0.2 && <0.3,
+ vector >=0.10.12.3 && <0.12,
+ vector-instances >=3.3.0.1 && <3.4
+ if flag(aeson-compat)
+ build-depends: aeson-compat >=0.3.0.0 && <0.4
+ else
+ build-depends: aeson-extra >=0.2.0.0 && <0.3
test-suite github-test
default-language: Haskell2010
type: exitcode-stdio-1.0
- hs-source-dirs: spec, .
+ hs-source-dirs: spec
+ other-modules:
+ GitHub.ActivitySpec
+ GitHub.CommitsSpec
+ GitHub.OrganizationsSpec
+ GitHub.ReposSpec
+ GitHub.SearchSpec
+ GitHub.UsersSpec
main-is: Spec.hs
- build-depends: base >= 4.0 && < 5.0,
- time,
- aeson >= 0.6.1.0,
- attoparsec >= 0.10.3.0,
- bytestring,
- case-insensitive >= 0.4.0.4,
- containers,
- hashable,
- text,
- old-locale,
- HTTP,
- network,
- http-conduit >= 1.8,
- conduit,
- failure,
- http-types,
- data-default,
+ ghc-options: -Wall
+ build-depends: base,
+ base-compat,
+ github,
vector,
- unordered-containers >= 0.2 && < 0.3,
- cryptohash >= 0.11,
- byteable >= 0.1.0,
- base16-bytestring >= 0.1.1.6
-
- , hspec
+ unordered-containers,
+ file-embed,
+ hspec
+ if flag(aeson-compat)
+ build-depends: aeson-compat
+ else
+ build-depends: aeson-extra
- ghc-options: -Wall -fno-warn-orphans
diff --git a/samples/Gists/Comments/ShowComment.hs b/samples/Gists/Comments/ShowComment.hs
deleted file mode 100644
--- a/samples/Gists/Comments/ShowComment.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-module ShowComment where
-
-import qualified Github.Gists.Comments as Github
-
-main = do
- possibleComment <- Github.comment "62449"
- case possibleComment of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right comment) -> putStrLn $ formatComment comment
-
-formatComment comment =
- (Github.githubOwnerLogin $ Github.gistCommentUser comment) ++ "\n" ++
- (formatGithubDate $ Github.gistCommentUpdatedAt comment) ++ "\n\n" ++
- (Github.gistCommentBody comment)
-
-formatGithubDate = show . Github.fromGithubDate
diff --git a/samples/Gists/Comments/ShowComments.hs b/samples/Gists/Comments/ShowComments.hs
deleted file mode 100644
--- a/samples/Gists/Comments/ShowComments.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-module ShowComments where
-
-import qualified Github.Gists.Comments as Github
-import Data.List (intercalate)
-
-main = do
- possibleComments <- Github.commentsOn "1174060"
- case possibleComments of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right comments) -> putStrLn $ intercalate "\n\n" $ map formatComment comments
-
-formatComment comment =
- (Github.githubOwnerLogin $ Github.gistCommentUser comment) ++ "\n" ++
- (formatGithubDate $ Github.gistCommentUpdatedAt comment) ++ "\n\n" ++
- (Github.gistCommentBody comment)
-
-formatGithubDate = show . Github.fromGithubDate
diff --git a/samples/Gists/ListGists.hs b/samples/Gists/ListGists.hs
deleted file mode 100644
--- a/samples/Gists/ListGists.hs
+++ /dev/null
@@ -1,15 +0,0 @@
-module ListGists where
-
-import qualified Github.Gists as Github
-import Data.List (intercalate)
-
-main = do
- possibleGists <- Github.gists "mike-burns"
- case possibleGists of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right gists) -> putStrLn $ intercalate "\n\n" $ map formatGist gists
-
-formatGist gist =
- (Github.gistId gist) ++ "\n" ++
- (maybe "indescribable" id $ Github.gistDescription gist) ++ "\n" ++
- (Github.gistHtmlUrl gist)
diff --git a/samples/Gists/ShowGist.hs b/samples/Gists/ShowGist.hs
deleted file mode 100644
--- a/samples/Gists/ShowGist.hs
+++ /dev/null
@@ -1,20 +0,0 @@
-module ShowGist where
-
-import qualified Github.Gists as Github
-import Data.List (intercalate)
-
-main = do
- possibleGist <- Github.gist "23084"
- case possibleGist of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right gist) -> putStrLn $ formatGist gist
-
-formatGist gist =
- (Github.gistId gist) ++ "\n" ++
- (maybe "indescribable" id $ Github.gistDescription gist) ++ "\n" ++
- (Github.gistHtmlUrl gist) ++ "\n\n" ++
- (intercalate "\n\n" $ map formatGistFile $ Github.gistFiles gist)
-
-formatGistFile gistFile =
- (Github.gistFileFilename gistFile) ++ ":\n" ++
- maybe "[empty]" id (Github.gistFileContent gistFile)
diff --git a/samples/GitData/Commits/GitShow.hs b/samples/GitData/Commits/GitShow.hs
deleted file mode 100644
--- a/samples/GitData/Commits/GitShow.hs
+++ /dev/null
@@ -1,23 +0,0 @@
-module GitShow where
-
-import qualified Github.GitData.Commits as Github
-import Data.Maybe (fromJust)
-
-main = do
- possibleCommit <- Github.commit "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9"
- case possibleCommit of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right commit) -> putStrLn $ formatCommit commit
-
-formatCommit :: Github.GitCommit -> String
-formatCommit commit =
- "commit " ++ (fromJust $ Github.gitCommitSha commit) ++
- "\nAuthor: " ++ (formatAuthor author) ++
- "\nDate: " ++ (show $ Github.fromGithubDate $ Github.gitUserDate author) ++
- "\n\n\t" ++ (Github.gitCommitMessage commit) ++ "\n"
- where author = Github.gitCommitAuthor commit
-
-formatAuthor :: Github.GitUser -> String
-formatAuthor author =
- (Github.gitUserName author) ++ " <" ++ (Github.gitUserEmail author) ++ ">"
-
diff --git a/samples/GitData/References/GitCreateReference.hs b/samples/GitData/References/GitCreateReference.hs
deleted file mode 100644
--- a/samples/GitData/References/GitCreateReference.hs
+++ /dev/null
@@ -1,19 +0,0 @@
-module GitCreateRef where
-
-import qualified Github.Auth as Auth
-import Github.GitData.References
-
-main :: IO ()
-main = do
- let auth = Auth.GithubOAuth "oauthtoken"
- newlyCreatedGitRef <- createReference auth "myrepo" "myowner" NewGitReference {
- newGitReferenceRef = "refs/heads/fav_tag"
- ,newGitReferenceSha = "aa218f56b14c9653891f9e74264a383fa43fefbd"
- }
- case newlyCreatedGitRef of
- (Left err) -> putStrLn $ "Error: " ++ show err
- (Right newRef) -> putStrLn . formatReference $ newRef
-
-formatReference :: GitReference -> String
-formatReference ref =
- (gitObjectSha $ gitReferenceObject ref) ++ "\t" ++ (gitReferenceRef ref)
diff --git a/samples/GitData/References/GitLsRemote.hs b/samples/GitData/References/GitLsRemote.hs
deleted file mode 100644
--- a/samples/GitData/References/GitLsRemote.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-module GitLsRemote where
-
-import qualified Github.GitData.References as Github
-import Data.List (intercalate)
-
-main = do
- possibleReferences <- Github.references "mike-burns" "github"
- case possibleReferences of
- (Left error) -> putStrLn $ "Error: " ++ show error
- (Right references) -> do
- putStrLn "From git@github.com:mike-burns/github.git"
- putStrLn $ intercalate "\n" $ map formatReference references
-
-formatReference reference =
- (Github.gitObjectSha $ Github.gitReferenceObject reference) ++
- "\t" ++ (Github.gitReferenceRef reference)
diff --git a/samples/GitData/References/GitLsRemoteTags.hs b/samples/GitData/References/GitLsRemoteTags.hs
deleted file mode 100644
--- a/samples/GitData/References/GitLsRemoteTags.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-module GitLsRemoteTags where
-
-import qualified Github.GitData.References as Github
-import Data.List (intercalate)
-
-main = do
- possibleReferences <- Github.namespacedReferences "thoughtbot" "paperclip" "tags"
- case possibleReferences of
- (Left error) -> putStrLn $ "Error: " ++ show error
- (Right references) -> do
- putStrLn "From git@github.com:thoughtbot/paperclip.git"
- putStrLn $ intercalate "\n" $ map formatReference references
-
-formatReference reference =
- (Github.gitObjectSha $ Github.gitReferenceObject reference) ++
- "\t" ++ (Github.gitReferenceRef reference)
-
diff --git a/samples/GitData/References/GitLsRemoteWithRef.hs b/samples/GitData/References/GitLsRemoteWithRef.hs
deleted file mode 100644
--- a/samples/GitData/References/GitLsRemoteWithRef.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module GitLsRemoteWithRef where
-
-import qualified Github.GitData.References as Github
-
-main = do
- possibleReference <- Github.reference "mike-burns" "github" "heads/master"
- putStrLn $ either (\e -> "Error: " ++ show e)
- formatReference
- possibleReference
-
-formatReference reference =
- (Github.gitObjectSha $ Github.gitReferenceObject reference) ++
- "\t" ++ (Github.gitReferenceRef reference)
diff --git a/samples/GitData/Trees/GitLsTree.hs b/samples/GitData/Trees/GitLsTree.hs
deleted file mode 100644
--- a/samples/GitData/Trees/GitLsTree.hs
+++ /dev/null
@@ -1,19 +0,0 @@
-module GitLsTree where
-
-import qualified Github.GitData.Trees as Github
-import Data.List (intercalate)
-
-main = do
- possibleTree <- Github.tree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844"
- case possibleTree of
- (Left error) -> putStrLn $ "Error: " ++ show error
- (Right tree) -> putStrLn $ formatTree tree
-
-formatTree tree =
- intercalate "\n" $ map formatGitTree $ Github.treeGitTrees tree
-
-formatGitTree gitTree =
- (Github.gitTreeMode gitTree) ++ " " ++
- (Github.gitTreeType gitTree) ++ " " ++
- (Github.gitTreeSha gitTree) ++ "\t" ++
- (Github.gitTreePath gitTree)
diff --git a/samples/GitData/Trees/GitLsTreeRecursively.hs b/samples/GitData/Trees/GitLsTreeRecursively.hs
deleted file mode 100644
--- a/samples/GitData/Trees/GitLsTreeRecursively.hs
+++ /dev/null
@@ -1,19 +0,0 @@
-module GitLsTreeRecursively where
-
-import qualified Github.GitData.Trees as Github
-import Data.List (intercalate)
-
-main = do
- possibleTree <- Github.nestedTree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844"
- case possibleTree of
- (Left error) -> putStrLn $ "Error: " ++ show error
- (Right tree) -> putStrLn $ formatTree tree
-
-formatTree tree =
- intercalate "\n" $ map formatGitTree $ Github.treeGitTrees tree
-
-formatGitTree gitTree =
- (Github.gitTreeMode gitTree) ++ " " ++
- (Github.gitTreeType gitTree) ++ " " ++
- (Github.gitTreeSha gitTree) ++ "\t" ++
- (Github.gitTreePath gitTree)
diff --git a/samples/Issues/Comments/ShowComment.hs b/samples/Issues/Comments/ShowComment.hs
deleted file mode 100644
--- a/samples/Issues/Comments/ShowComment.hs
+++ /dev/null
@@ -1,15 +0,0 @@
-module ShowComment where
-
-import qualified Github.Issues.Comments as Github
-
-main = do
- possibleComment <- Github.comment "thoughtbot" "paperclip" 1468184
- putStrLn $ either (\e -> "Error: " ++ show e)
- formatComment
- possibleComment
-
-formatComment comment =
- (Github.githubOwnerLogin $ Github.issueCommentUser comment) ++
- " commented " ++
- (show $ Github.fromGithubDate $ Github.issueCommentUpdatedAt comment) ++
- "\n" ++ (Github.issueCommentBody comment)
diff --git a/samples/Issues/Comments/ShowComments.hs b/samples/Issues/Comments/ShowComments.hs
deleted file mode 100644
--- a/samples/Issues/Comments/ShowComments.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-module ShowComments where
-
-import qualified Github.Issues.Comments as Github
-import Data.List (intercalate)
-
-main = do
- possibleComments <- Github.comments "thoughtbot" "paperclip" 635
- case possibleComments of
- (Left error) -> putStrLn $ "Error: " ++ show error
- (Right issues) ->
- putStrLn $ intercalate "\n\n" $ map formatComment issues
-
-formatComment comment =
- (Github.githubOwnerLogin $ Github.issueCommentUser comment) ++
- " commented " ++
- (show $ Github.fromGithubDate $ Github.issueCommentUpdatedAt comment) ++
- "\n" ++ (Github.issueCommentBody comment)
diff --git a/samples/Issues/Events/ShowEvent.hs b/samples/Issues/Events/ShowEvent.hs
deleted file mode 100644
--- a/samples/Issues/Events/ShowEvent.hs
+++ /dev/null
@@ -1,38 +0,0 @@
-module ShowEvents where
-
-import qualified Github.Issues.Events as Github
-import Data.List (intercalate)
-import Data.Maybe (fromJust)
-
-main = do
- possibleEvent <- Github.event "thoughtbot" "paperclip" 5335772
- case possibleEvent of
- (Left error) -> putStrLn $ "Error: " ++ show error
- (Right event) -> do
- putStrLn $ formatEvent event
-
-formatEvent event = formatEvent' event (Github.eventType event)
- where
- formatEvent' event Github.Closed =
- "Closed on " ++ createdAt event ++ " by " ++ loginName event ++
- withCommitId event (\commitId -> " in the commit " ++ commitId)
- formatEvent' event Github.Reopened =
- "Reopened on " ++ createdAt event ++ " by " ++ loginName event
- formatEvent' event Github.Subscribed =
- loginName event ++ " is subscribed to receive notifications"
- formatEvent' event Github.Unsubscribed =
- loginName event ++ " is unsubscribed from notifications"
- formatEvent' event Github.Merged =
- "Issue merged by " ++ loginName event ++ " on " ++ createdAt event ++
- (withCommitId event $ \commitId -> " in the commit " ++ commitId)
- formatEvent' event Github.Referenced =
- withCommitId event $ \commitId ->
- "Issue referenced from " ++ commitId ++ " by " ++ loginName event
- formatEvent' event Github.Mentioned =
- loginName event ++ " was mentioned in the issue's body"
- formatEvent' event Github.Assigned =
- "Issue assigned to " ++ loginName event ++ " on " ++ createdAt event
-
-loginName = Github.githubOwnerLogin . Github.eventActor
-createdAt = show . Github.fromGithubDate . Github.eventCreatedAt
-withCommitId event f = maybe "" f (Github.eventCommitId event)
diff --git a/samples/Issues/Events/ShowIssueEvents.hs b/samples/Issues/Events/ShowIssueEvents.hs
deleted file mode 100644
--- a/samples/Issues/Events/ShowIssueEvents.hs
+++ /dev/null
@@ -1,38 +0,0 @@
-module ShowIssueEvents where
-
-import qualified Github.Issues.Events as Github
-import Data.List (intercalate)
-
-main = do
- possibleEvents <- Github.eventsForIssue "thoughtbot" "paperclip" 49
- case possibleEvents of
- (Left error) -> putStrLn $ "Error: " ++ show error
- (Right events) -> do
- putStrLn "Issue #49:\n"
- putStrLn $ intercalate "\n" $ map formatEvent events
-
-formatEvent event = formatEvent' event (Github.eventType event)
- where
- formatEvent' event Github.Closed =
- "Closed on " ++ createdAt event ++ " by " ++ loginName event ++
- withCommitId event (\commitId -> " in the commit " ++ commitId)
- formatEvent' event Github.Reopened =
- "Reopened on " ++ createdAt event ++ " by " ++ loginName event
- formatEvent' event Github.Subscribed =
- loginName event ++ " is subscribed to receive notifications"
- formatEvent' event Github.Unsubscribed =
- loginName event ++ " is unsubscribed from notifications"
- formatEvent' event Github.Merged =
- "Issue merged by " ++ loginName event ++ " on " ++ createdAt event ++
- (withCommitId event $ \commitId -> " in the commit " ++ commitId)
- formatEvent' event Github.Referenced =
- withCommitId event $ \commitId ->
- "Issue referenced from " ++ commitId ++ " by " ++ loginName event
- formatEvent' event Github.Mentioned =
- loginName event ++ " was mentioned in the issue's body"
- formatEvent' event Github.Assigned =
- "Issue assigned to " ++ loginName event ++ " on " ++ createdAt event
-
-loginName = Github.githubOwnerLogin . Github.eventActor
-createdAt = show . Github.fromGithubDate . Github.eventCreatedAt
-withCommitId event f = maybe "" f (Github.eventCommitId event)
diff --git a/samples/Issues/Events/ShowRepoEvents.hs b/samples/Issues/Events/ShowRepoEvents.hs
deleted file mode 100644
--- a/samples/Issues/Events/ShowRepoEvents.hs
+++ /dev/null
@@ -1,41 +0,0 @@
-module ShowRepoEvents where
-
-import qualified Github.Issues.Events as Github
-import Data.List (intercalate)
-import Data.Maybe (fromJust)
-
-main = do
- possibleEvents <- Github.eventsForRepo "thoughtbot" "paperclip"
- case possibleEvents of
- (Left error) -> putStrLn $ "Error: " ++ show error
- (Right events) -> do
- putStrLn $ intercalate "\n" $ map formatEvent events
-
-formatEvent event =
- "Issue #" ++ issueNumber event ++ ": " ++
- formatEvent' event (Github.eventType event)
- where
- formatEvent' event Github.Closed =
- "closed on " ++ createdAt event ++ " by " ++ loginName event ++
- withCommitId event (\commitId -> " in the commit " ++ commitId)
- formatEvent' event Github.Reopened =
- "reopened on " ++ createdAt event ++ " by " ++ loginName event
- formatEvent' event Github.Subscribed =
- loginName event ++ " is subscribed to receive notifications"
- formatEvent' event Github.Unsubscribed =
- loginName event ++ " is unsubscribed from notifications"
- formatEvent' event Github.Merged =
- "merged by " ++ loginName event ++ " on " ++ createdAt event ++
- (withCommitId event $ \commitId -> " in the commit " ++ commitId)
- formatEvent' event Github.Referenced =
- withCommitId event $ \commitId ->
- "referenced from " ++ commitId ++ " by " ++ loginName event
- formatEvent' event Github.Mentioned =
- loginName event ++ " was mentioned in the issue's body"
- formatEvent' event Github.Assigned =
- "assigned to " ++ loginName event ++ " on " ++ createdAt event
-
-loginName = Github.githubOwnerLogin . Github.eventActor
-createdAt = show . Github.fromGithubDate . Github.eventCreatedAt
-withCommitId event f = maybe "" f (Github.eventCommitId event)
-issueNumber = show . Github.issueNumber . fromJust . Github.eventIssue
diff --git a/samples/Issues/Labels/ShowIssueLabels.hs b/samples/Issues/Labels/ShowIssueLabels.hs
deleted file mode 100644
--- a/samples/Issues/Labels/ShowIssueLabels.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-module ShowIssueLabels where
-
-import qualified Github.Issues.Labels as Github
-import Data.List (intercalate)
-
-main = do
- possibleLabels <- Github.labelsOnIssue "thoughtbot" "paperclip" 585
- case possibleLabels of
- (Left error) -> putStrLn $ "Error: " ++ show error
- (Right labels) -> do
- putStrLn $ intercalate "\n" $ map formatLabel labels
-
-formatLabel label =
- (Github.labelName label) ++ ", colored " ++ (Github.labelColor label)
diff --git a/samples/Issues/Labels/ShowLabel.hs b/samples/Issues/Labels/ShowLabel.hs
deleted file mode 100644
--- a/samples/Issues/Labels/ShowLabel.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module ShowLabel where
-
-import qualified Github.Issues.Labels as Github
-
-main = do
- possibleLabel <- Github.label "thoughtbot" "paperclip" "bug"
- case possibleLabel of
- (Left error) -> putStrLn $ "Error: " ++ show error
- (Right label) -> putStrLn $ formatLabel label
-
-formatLabel label =
- (Github.labelName label) ++ ", colored " ++ (Github.labelColor label)
-
diff --git a/samples/Issues/Labels/ShowMilestoneLabels.hs b/samples/Issues/Labels/ShowMilestoneLabels.hs
deleted file mode 100644
--- a/samples/Issues/Labels/ShowMilestoneLabels.hs
+++ /dev/null
@@ -1,15 +0,0 @@
-module ShowMilestoneLabels where
-
-import qualified Github.Issues.Labels as Github
-import Data.List (intercalate)
-
-main = do
- possibleLabels <- Github.labelsOnMilestone "thoughtbot" "paperclip" 2
- case possibleLabels of
- (Left error) -> putStrLn $ "Error: " ++ show error
- (Right labels) -> do
- putStrLn $ intercalate "\n" $ map formatLabel labels
-
-formatLabel label =
- (Github.labelName label) ++ ", colored " ++ (Github.labelColor label)
-
diff --git a/samples/Issues/Labels/ShowRepoLabels.hs b/samples/Issues/Labels/ShowRepoLabels.hs
deleted file mode 100644
--- a/samples/Issues/Labels/ShowRepoLabels.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-module ShowRepoLabels where
-
-import qualified Github.Issues.Labels as Github
-import Data.List (intercalate)
-
-main = do
- possibleLabels <- Github.labelsOnRepo "thoughtbot" "paperclip"
- case possibleLabels of
- (Left error) -> putStrLn $ "Error: " ++ show error
- (Right labels) -> do
- putStrLn $ intercalate "\n" $ map formatLabel labels
-
-formatLabel label =
- (Github.labelName label) ++ ", colored " ++ (Github.labelColor label)
diff --git a/samples/Issues/Milestones/ShowMilestone.hs b/samples/Issues/Milestones/ShowMilestone.hs
deleted file mode 100644
--- a/samples/Issues/Milestones/ShowMilestone.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-module ShowMilestone where
-
-import qualified Github.Issues.Milestones as Github
-import Data.List (intercalate)
-
-main = do
- possibleMilestone <- Github.milestone "thoughtbot" "paperclip" 2
- case possibleMilestone of
- (Left error) -> putStrLn $ "Error: " ++ show error
- (Right milestone) ->
- putStrLn $ formatMilestone milestone
-
-formatMilestone milestone =
- (Github.milestoneTitle milestone) ++ ", as created by " ++
- (loginName milestone) ++ " on " ++ (createdAt milestone) ++
- formatDueOn (Github.milestoneDueOn milestone) ++ " and has the " ++
- (Github.milestoneState milestone) ++ " status"
-
-formatDueOn Nothing = ""
-formatDueOn (Just milestoneDate) = ", is due on " ++ dueOn milestoneDate
-
-loginName = Github.githubOwnerLogin . Github.milestoneCreator
-createdAt = show . Github.fromGithubDate . Github.milestoneCreatedAt
-dueOn = show . Github.fromGithubDate
diff --git a/samples/Issues/Milestones/ShowMilestones.hs b/samples/Issues/Milestones/ShowMilestones.hs
deleted file mode 100644
--- a/samples/Issues/Milestones/ShowMilestones.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-module ShowMilestones where
-
-import qualified Github.Issues.Milestones as Github
-import Data.List (intercalate)
-
-main = do
- possibleMilestones <- Github.milestones "thoughtbot" "paperclip"
- case possibleMilestones of
- (Left error) -> putStrLn $ "Error: " ++ show error
- (Right milestones) ->
- putStrLn $ intercalate "\n\n" $ map formatMilestone milestones
-
-formatMilestone milestone =
- (Github.milestoneTitle milestone) ++ ", as created by " ++
- (loginName milestone) ++ " on " ++ (createdAt milestone) ++
- formatDueOn (Github.milestoneDueOn milestone) ++ " and has the " ++
- (Github.milestoneState milestone) ++ " status"
-
-formatDueOn Nothing = ""
-formatDueOn (Just milestoneDate) = ", is due on " ++ dueOn milestoneDate
-
-loginName = Github.githubOwnerLogin . Github.milestoneCreator
-createdAt = show . Github.fromGithubDate . Github.milestoneCreatedAt
-dueOn = show . Github.fromGithubDate
diff --git a/samples/Issues/ShowIssue.hs b/samples/Issues/ShowIssue.hs
deleted file mode 100644
--- a/samples/Issues/ShowIssue.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-module ShowIssue where
-
-import qualified Github.Issues as Github
-
-main = do
- possibleIssue <- Github.issue "thoughtbot" "paperclip" 549
- 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/ShowRepoIssues.hs b/samples/Issues/ShowRepoIssues.hs
deleted file mode 100644
--- a/samples/Issues/ShowRepoIssues.hs
+++ /dev/null
@@ -1,21 +0,0 @@
-module ShowRepoIssue where
-
-import qualified Github.Issues as Github
-import Data.List (intercalate)
-
-main = do
- let limitations = [Github.OnlyClosed, Github.Mentions "mike-burns", Github.AssignedTo "jyurek"]
- possibleIssues <- Github.issuesForRepo "thoughtbot" "paperclip" limitations
- case possibleIssues of
- (Left error) -> putStrLn $ "Error: " ++ show error
- (Right issues) ->
- putStrLn $ intercalate "\n\n" $ map formatIssue issues
-
-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/Organizations/Members/ShowMembers.hs b/samples/Organizations/Members/ShowMembers.hs
deleted file mode 100644
--- a/samples/Organizations/Members/ShowMembers.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-module ShowMembers where
-
-import qualified Github.Organizations.Members as Github
-import Data.List (intercalate)
-
-main = do
- possibleMembers <- Github.membersOf "thoughtbot"
- case possibleMembers of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right members) ->
- putStrLn $ intercalate "\n" $ map Github.githubOwnerLogin members
diff --git a/samples/Organizations/ShowPublicOrganization.hs b/samples/Organizations/ShowPublicOrganization.hs
deleted file mode 100644
--- a/samples/Organizations/ShowPublicOrganization.hs
+++ /dev/null
@@ -1,15 +0,0 @@
-module ShowPublicOrganization where
-
-import qualified Github.Organizations as Github
-
-main = do
- possibleOrganization <- Github.publicOrganization "thoughtbot"
- case possibleOrganization of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right organization) ->
- putStrLn $ formatOrganization organization
-
-formatOrganization organization =
- (maybe "" (\s -> s ++ "\n") (Github.organizationName organization)) ++
- (Github.organizationHtmlUrl organization) ++
- (maybe "" (\s -> "\n" ++ s) (Github.organizationBlog organization))
diff --git a/samples/Organizations/ShowPublicOrganizations.hs b/samples/Organizations/ShowPublicOrganizations.hs
deleted file mode 100644
--- a/samples/Organizations/ShowPublicOrganizations.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module ShowPublicOrganizations where
-
-import qualified Github.Organizations as Github
-import Data.List (intercalate)
-
-main = do
- possibleOrganizations <- Github.publicOrganizationsFor "mike-burns"
- case possibleOrganizations of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right organizations) ->
- putStrLn $ intercalate "\n" $ map formatOrganization organizations
-
-formatOrganization = Github.simpleOrganizationLogin
diff --git a/samples/Pulls/Diff.hs b/samples/Pulls/Diff.hs
deleted file mode 100644
--- a/samples/Pulls/Diff.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module Diff where
-
-import qualified Github.PullRequests as Github
-import Data.List
-
-main = do
- possiblePullRequestFiles <- Github.pullRequestFiles "thoughtbot" "paperclip" 575
- case possiblePullRequestFiles of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right files) -> putStrLn $ intercalate "\n\n" $ map formatFile files
-
-formatFile file =
- Github.fileFilename file ++ "\n" ++ Github.filePatch file
diff --git a/samples/Pulls/ListPulls.hs b/samples/Pulls/ListPulls.hs
deleted file mode 100644
--- a/samples/Pulls/ListPulls.hs
+++ /dev/null
@@ -1,23 +0,0 @@
-module ListPulls where
-
-import qualified Github.PullRequests as Github
-import Data.List
-
-main = do
- possiblePullRequests <- Github.pullRequestsFor "thoughtbot" "paperclip"
- case possiblePullRequests of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right pullRequests) ->
- putStrLn $ intercalate "\n\n" $ map formatPullRequest pullRequests
-
-formatPullRequest pullRequest =
- (Github.pullRequestTitle pullRequest) ++ "\n" ++
- (take 80 $ Github.pullRequestBody pullRequest) ++ "\n" ++
- (Github.githubOwnerLogin $ Github.pullRequestUser pullRequest) ++
- " submitted to thoughtbot/paperclip " ++
- (formatGithubDate $ Github.pullRequestCreatedAt pullRequest) ++
- " updated " ++
- (formatGithubDate $ Github.pullRequestUpdatedAt pullRequest) ++ "\n" ++
- (Github.pullRequestHtmlUrl pullRequest)
-
-formatGithubDate = show . Github.fromGithubDate
diff --git a/samples/Pulls/ReviewComments/ListComments.hs b/samples/Pulls/ReviewComments/ListComments.hs
deleted file mode 100644
--- a/samples/Pulls/ReviewComments/ListComments.hs
+++ /dev/null
@@ -1,21 +0,0 @@
-module ListComments where
-
-import qualified Github.PullRequests.ReviewComments as Github
-import Data.List
-
-main = do
- possiblePullRequestComments <- Github.pullRequestReviewComments "thoughtbot" "factory_girl" 256
- case possiblePullRequestComments of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right comments) -> putStrLn $ intercalate "\n\n" $ map formatComment comments
-
-formatComment :: Github.Comment -> String
-formatComment comment =
- "Author: " ++ (formatAuthor $ Github.commentUser comment) ++
- "\nUpdated: " ++ (show $ Github.commentUpdatedAt comment) ++
- (maybe "" ("\nURL: "++) $ Github.commentHtmlUrl comment) ++
- "\n\n" ++ (Github.commentBody comment)
-
-formatAuthor :: Github.GithubOwner -> String
-formatAuthor user =
- (Github.githubOwnerLogin user) ++ " (" ++ (Github.githubOwnerUrl user) ++ ")"
diff --git a/samples/Pulls/ReviewComments/ShowComment.hs b/samples/Pulls/ReviewComments/ShowComment.hs
deleted file mode 100644
--- a/samples/Pulls/ReviewComments/ShowComment.hs
+++ /dev/null
@@ -1,22 +0,0 @@
-module ShowComments where
-
-import qualified Github.PullRequests.ReviewComments as Github
-import Data.List
-
-main = do
- possiblePullRequestComment <- Github.pullRequestReviewComment "thoughtbot" "factory_girl" 301819
- case possiblePullRequestComment of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right comment) -> putStrLn $ formatComment comment
-
-formatComment :: Github.Comment -> String
-formatComment comment =
- "Author: " ++ (formatAuthor $ Github.commentUser comment) ++
- "\nUpdated: " ++ (show $ Github.commentUpdatedAt comment) ++
- (maybe "" ("\nURL: "++) $ Github.commentHtmlUrl comment) ++
- "\n\n" ++ (Github.commentBody comment)
-
-formatAuthor :: Github.GithubOwner -> String
-formatAuthor user =
- (Github.githubOwnerLogin user) ++ " (" ++ (Github.githubOwnerUrl user) ++ ")"
-
diff --git a/samples/Pulls/ShowCommits.hs b/samples/Pulls/ShowCommits.hs
deleted file mode 100644
--- a/samples/Pulls/ShowCommits.hs
+++ /dev/null
@@ -1,21 +0,0 @@
-module ShowCommits where
-
-import qualified Github.PullRequests as Github
-import Data.List
-import Data.Maybe
-
-main = do
- possiblePullRequestCommits <- Github.pullRequestCommits "thoughtbot" "paperclip" 575
- case possiblePullRequestCommits of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right commits) -> putStrLn $ intercalate "\n" $ map formatCommit commits
-
-formatCommit commit =
- (formatAuthor $ Github.gitCommitAuthor gitCommit) ++ "\n" ++
- (maybe "unknown SHA" id $ Github.gitCommitSha gitCommit) ++ "\n" ++
- (Github.gitCommitMessage gitCommit)
- where gitCommit = Github.commitGitCommit commit
-
-formatAuthor :: Github.GitUser -> String
-formatAuthor author =
- (Github.gitUserName author) ++ " <" ++ (Github.gitUserEmail author) ++ ">"
diff --git a/samples/Pulls/ShowPull.hs b/samples/Pulls/ShowPull.hs
deleted file mode 100644
--- a/samples/Pulls/ShowPull.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-module ShowPull where
-
-import qualified Github.PullRequests as Github
-import Data.List
-
-main = do
- possiblePullRequest <- Github.pullRequest "thoughtbot" "paperclip" 575
- case possiblePullRequest of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right pullRequest) -> putStrLn $ formatPullRequest pullRequest
-
-formatPullRequest p =
- (Github.githubOwnerLogin $ Github.detailedPullRequestUser p) ++
- " opened this pull request " ++
- (formatGithubDate $ Github.detailedPullRequestCreatedAt p) ++ "\n" ++
- (Github.detailedPullRequestTitle p) ++ "\n" ++
- (Github.detailedPullRequestBody p) ++ "\n" ++
- (Github.detailedPullRequestState p) ++ "\n" ++
- "+" ++ (show $ Github.detailedPullRequestAdditions p) ++ " additions\n" ++
- "-" ++ (show $ Github.detailedPullRequestDeletions p) ++ " deletions\n" ++
- (show $ Github.detailedPullRequestComments p) ++ " comments\n" ++
- (Github.detailedPullRequestHtmlUrl p)
-
-formatGithubDate = show . Github.fromGithubDate
diff --git a/samples/Repos/Collaborators/IsCollaborator.hs b/samples/Repos/Collaborators/IsCollaborator.hs
deleted file mode 100644
--- a/samples/Repos/Collaborators/IsCollaborator.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-module IsCollaborator where
-
-import qualified Github.Repos.Collaborators as Github
-import Data.List
-
-main = do
- let userName = "ubuwaits"
- possiblyIsCollaborator <- Github.isCollaboratorOn userName "thoughtbot" "paperclip"
- case possiblyIsCollaborator of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right True) ->
- putStrLn $ userName ++ " is a collaborator on thoughtbot's paperclip"
- (Right False) ->
- putStrLn $ userName ++ " does not collaborate on thoughtbot's paperclip"
diff --git a/samples/Repos/Collaborators/ListCollaborators.hs b/samples/Repos/Collaborators/ListCollaborators.hs
deleted file mode 100644
--- a/samples/Repos/Collaborators/ListCollaborators.hs
+++ /dev/null
@@ -1,15 +0,0 @@
-module ListCollaborators where
-
-import qualified Github.Repos.Collaborators as Github
-import Data.List
-
-main = do
- possibleCollaborators <- Github.collaboratorsOn "thoughtbot" "paperclip"
- case possibleCollaborators of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right collaborators) ->
- putStrLn $ intercalate "\n" $ map formatAuthor collaborators
-
-formatAuthor :: Github.GithubOwner -> String
-formatAuthor user =
- (Github.githubOwnerLogin user) ++ " (" ++ (Github.githubOwnerUrl user) ++ ")"
diff --git a/samples/Repos/Commits/CommitComment.hs b/samples/Repos/Commits/CommitComment.hs
deleted file mode 100644
--- a/samples/Repos/Commits/CommitComment.hs
+++ /dev/null
@@ -1,21 +0,0 @@
-module CommitComment where
-
-import qualified Github.Repos.Commits as Github
-import Data.Maybe (maybe)
-
-main = do
- possibleComment <- Github.commitCommentFor "thoughtbot" "paperclip" "669575"
- case possibleComment of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right comment) -> putStrLn $ formatComment comment
-
-formatComment :: Github.Comment -> String
-formatComment comment =
- "Author: " ++ (formatAuthor $ Github.commentUser comment) ++
- "\nUpdated: " ++ (show $ Github.commentUpdatedAt comment) ++
- (maybe "" ("\nURL: "++) $ Github.commentHtmlUrl comment) ++
- "\n\n" ++ (Github.commentBody comment)
-
-formatAuthor :: Github.GithubOwner -> String
-formatAuthor user =
- (Github.githubOwnerLogin user) ++ " (" ++ (Github.githubOwnerUrl user) ++ ")"
diff --git a/samples/Repos/Commits/CommitComments.hs b/samples/Repos/Commits/CommitComments.hs
deleted file mode 100644
--- a/samples/Repos/Commits/CommitComments.hs
+++ /dev/null
@@ -1,22 +0,0 @@
-module CommitComments where
-
-import qualified Github.Repos.Commits as Github
-import Data.List
-import Data.Maybe (maybe)
-
-main = do
- possibleComments <- Github.commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b"
- case possibleComments of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right comments) -> putStrLn $ intercalate "\n\n" $ map formatComment comments
-
-formatComment :: Github.Comment -> String
-formatComment comment =
- "Author: " ++ (formatAuthor $ Github.commentUser comment) ++
- "\nUpdated: " ++ (show $ Github.commentUpdatedAt comment) ++
- (maybe "" ("\nURL: "++) $ Github.commentHtmlUrl comment) ++
- "\n\n" ++ (Github.commentBody comment)
-
-formatAuthor :: Github.GithubOwner -> String
-formatAuthor user =
- (Github.githubOwnerLogin user) ++ " (" ++ (Github.githubOwnerUrl user) ++ ")"
diff --git a/samples/Repos/Commits/GitDiff.hs b/samples/Repos/Commits/GitDiff.hs
deleted file mode 100644
--- a/samples/Repos/Commits/GitDiff.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module GitDiff where
-
-import qualified Github.Repos.Commits as Github
-import Data.List
-
-main = do
- possibleDiff <- Github.diff "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" "HEAD"
- either (\error -> putStrLn $ "Error: " ++ (show error))
- (putStrLn . showDiff)
- possibleDiff
-
-showDiff diff =
- intercalate "\n\n" $ map Github.filePatch $ Github.diffFiles diff
diff --git a/samples/Repos/Commits/GitLog.hs b/samples/Repos/Commits/GitLog.hs
deleted file mode 100644
--- a/samples/Repos/Commits/GitLog.hs
+++ /dev/null
@@ -1,23 +0,0 @@
-module GitLog where
-
-import qualified Github.Repos.Commits as Github
-import Data.List
-
-main = do
- possibleCommits <- Github.commitsFor "thoughtbot" "paperclip"
- case possibleCommits of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right commits) -> putStrLn $ intercalate "\n\n" $ map formatCommit commits
-
-formatCommit :: Github.Commit -> String
-formatCommit commit =
- "commit " ++ (Github.commitSha commit) ++
- "\nAuthor: " ++ (formatAuthor author) ++
- "\nDate: " ++ (show $ Github.fromGithubDate $ Github.gitUserDate author) ++
- "\n\n\t" ++ (Github.gitCommitMessage gitCommit)
- where author = Github.gitCommitAuthor gitCommit
- gitCommit = Github.commitGitCommit commit
-
-formatAuthor :: Github.GitUser -> String
-formatAuthor author =
- (Github.gitUserName author) ++ " <" ++ (Github.gitUserEmail author) ++ ">"
diff --git a/samples/Repos/Commits/GitShow.hs b/samples/Repos/Commits/GitShow.hs
deleted file mode 100644
--- a/samples/Repos/Commits/GitShow.hs
+++ /dev/null
@@ -1,27 +0,0 @@
-module GitShow where
-
-import qualified Github.Repos.Commits as Github
-import Data.List
-
-main = do
- possibleCommit <- Github.commit "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9"
- case possibleCommit of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right commit) -> putStrLn $ formatCommit commit
-
-formatCommit :: Github.Commit -> String
-formatCommit commit =
- "commit " ++ (Github.commitSha commit) ++
- "\nAuthor: " ++ (formatAuthor author) ++
- "\nDate: " ++ (show $ Github.fromGithubDate $ Github.gitUserDate author) ++
- "\n\n\t" ++ (Github.gitCommitMessage gitCommit) ++ "\n" ++
- patches
- where author = Github.gitCommitAuthor gitCommit
- gitCommit = Github.commitGitCommit commit
- patches =
- intercalate "\n" $ map Github.filePatch $ Github.commitFiles commit
-
-formatAuthor :: Github.GitUser -> String
-formatAuthor author =
- (Github.gitUserName author) ++ " <" ++ (Github.gitUserEmail author) ++ ">"
-
diff --git a/samples/Repos/Commits/RepoComments.hs b/samples/Repos/Commits/RepoComments.hs
deleted file mode 100644
--- a/samples/Repos/Commits/RepoComments.hs
+++ /dev/null
@@ -1,22 +0,0 @@
-module RepoComments where
-
-import qualified Github.Repos.Commits as Github
-import Data.List
-import Data.Maybe (maybe)
-
-main = do
- possibleComments <- Github.commentsFor "thoughtbot" "paperclip"
- case possibleComments of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right comments) -> putStrLn $ intercalate "\n\n" $ map formatComment comments
-
-formatComment :: Github.Comment -> String
-formatComment comment =
- "Author: " ++ (formatAuthor $ Github.commentUser comment) ++
- "\nUpdated: " ++ (show $ Github.commentUpdatedAt comment) ++
- (maybe "" ("\nURL: "++) $ Github.commentHtmlUrl comment) ++
- "\n\n" ++ (Github.commentBody comment)
-
-formatAuthor :: Github.GithubOwner -> String
-formatAuthor user =
- (Github.githubOwnerLogin user) ++ " (" ++ (Github.githubOwnerUrl user) ++ ")"
diff --git a/samples/Repos/Forks/ListForks.hs b/samples/Repos/Forks/ListForks.hs
deleted file mode 100644
--- a/samples/Repos/Forks/ListForks.hs
+++ /dev/null
@@ -1,21 +0,0 @@
-module ListForks where
-
-import qualified Github.Repos.Forks as Github
-import Data.List
-
-main = do
- possibleForks <- Github.forksFor "thoughtbot" "paperclip"
- putStrLn $ either (("Error: "++) . show)
- (intercalate "\n\n" . map formatFork)
- possibleForks
-
-formatFork fork =
- (Github.githubOwnerLogin $ Github.repoOwner fork) ++ "\t" ++
- (formatPushedAt $ Github.repoPushedAt fork) ++ "\n" ++
- (formatCloneUrl $ Github.repoCloneUrl fork)
-
-formatPushedAt Nothing = ""
-formatPushedAt (Just pushedAt) = show $ Github.fromGithubDate pushedAt
-
-formatCloneUrl Nothing = ""
-formatCloneUrl (Just cloneUrl) = cloneUrl
diff --git a/samples/Repos/ListBranches.hs b/samples/Repos/ListBranches.hs
deleted file mode 100644
--- a/samples/Repos/ListBranches.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-module ListBranches where
-
-import qualified Github.Repos as Github
-import Data.List
-
-main = do
- possibleBranches <- Github.branchesFor "thoughtbot" "paperclip"
- case possibleBranches of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right branches) ->
- putStrLn $ intercalate "\n" $ map Github.branchName branches
diff --git a/samples/Repos/ListContributors.hs b/samples/Repos/ListContributors.hs
deleted file mode 100644
--- a/samples/Repos/ListContributors.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-module ListContributors where
-
-import qualified Github.Repos as Github
-import Data.List
-
-main = do
- possibleContributors <- Github.contributors "thoughtbot" "paperclip"
- case possibleContributors of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right contributors) ->
- putStrLn $ intercalate "\n" $ map formatContributor contributors
-
-formatContributor (Github.KnownContributor contributions _ login _ _ _) =
- (show $ contributions) ++ "\t" ++ login
-formatContributor (Github.AnonymousContributor contributions name) =
- (show $ contributions) ++ "\t" ++ name
diff --git a/samples/Repos/ListContributorsWithAnonymous.hs b/samples/Repos/ListContributorsWithAnonymous.hs
deleted file mode 100644
--- a/samples/Repos/ListContributorsWithAnonymous.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-module ListContributorsWithAnonymous where
-
-import qualified Github.Repos as Github
-import Data.List
-
-main = do
- possibleContributors <- Github.contributorsWithAnonymous "thoughtbot" "paperclip"
- case possibleContributors of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right contributors) ->
- putStrLn $ intercalate "\n" $ map formatContributor contributors
-
-formatContributor (Github.KnownContributor contributions _ login _ _ _) =
- (show $ contributions) ++ "\t" ++ login
-formatContributor (Github.AnonymousContributor contributions name) =
- (show $ contributions) ++ "\t" ++ name
diff --git a/samples/Repos/ListLanguages.hs b/samples/Repos/ListLanguages.hs
deleted file mode 100644
--- a/samples/Repos/ListLanguages.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-module ListLanguages where
-
-import qualified Github.Repos as Github
-import Data.List
-
-main = do
- possibleLanguages <- Github.languagesFor "mike-burns" "ohlaunch"
- case possibleLanguages of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right languages) ->
- putStrLn $ intercalate "\n" $ map formatLanguage languages
-
-formatLanguage (Github.Language name characterCount) =
- name ++ "\t" ++ show characterCount
diff --git a/samples/Repos/ListOrgRepos.hs b/samples/Repos/ListOrgRepos.hs
deleted file mode 100644
--- a/samples/Repos/ListOrgRepos.hs
+++ /dev/null
@@ -1,27 +0,0 @@
-module ListOrgRepos where
-
-import qualified Github.Repos as Github
-import Data.List
-import Data.Maybe
-
-main = do
- possibleRepos <- Github.organizationRepos "thoughtbot"
- case possibleRepos of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right repos) -> putStrLn $ intercalate "\n\n" $ map formatRepo repos
-
-formatRepo repo =
- (Github.repoName repo) ++ "\t" ++
- (fromMaybe "" $ Github.repoDescription repo) ++ "\n" ++
- (Github.repoHtmlUrl repo) ++ "\n" ++
- (fromMaybe "" $ Github.repoCloneUrl repo) ++ "\t" ++
- (formatDate $ Github.repoUpdatedAt repo) ++ "\n" ++
- formatLanguage (Github.repoLanguage repo) ++
- "watchers: " ++ (show $ Github.repoWatchers repo) ++ "\t" ++
- "forks: " ++ (show $ Github.repoForks repo)
-
-formatDate (Just date) = show . Github.fromGithubDate $ date
-formatDate Nothing = "????"
-
-formatLanguage (Just language) = "language: " ++ language ++ "\t"
-formatLanguage Nothing = ""
diff --git a/samples/Repos/ListTags.hs b/samples/Repos/ListTags.hs
deleted file mode 100644
--- a/samples/Repos/ListTags.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-module ListTags where
-
-import qualified Github.Repos as Github
-import Data.List
-
-main = do
- possibleTags <- Github.tagsFor "thoughtbot" "paperclip"
- case possibleTags of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right tags) ->
- putStrLn $ intercalate "\n" $ map Github.tagName tags
diff --git a/samples/Repos/ListUserRepos.hs b/samples/Repos/ListUserRepos.hs
deleted file mode 100644
--- a/samples/Repos/ListUserRepos.hs
+++ /dev/null
@@ -1,27 +0,0 @@
-module ListUserRepos where
-
-import qualified Github.Repos as Github
-import Data.List
-import Data.Maybe
-
-main = do
- possibleRepos <- Github.userRepos "mike-burns" Github.Owner
- case possibleRepos of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right repos) -> putStrLn $ intercalate "\n\n" $ map formatRepo repos
-
-formatRepo repo =
- (Github.repoName repo) ++ "\t" ++
- (fromMaybe "" $ Github.repoDescription repo) ++ "\n" ++
- (Github.repoHtmlUrl repo) ++ "\n" ++
- (fromMaybe "" $ Github.repoCloneUrl repo) ++ "\t" ++
- (formatDate $ Github.repoUpdatedAt repo) ++ "\n" ++
- formatLanguage (Github.repoLanguage repo) ++
- "watchers: " ++ (show $ Github.repoWatchers repo) ++ "\t" ++
- "forks: " ++ (show $ Github.repoForks repo)
-
-formatDate (Just date) = show . Github.fromGithubDate $ date
-formatDate Nothing = ""
-
-formatLanguage (Just language) = "language: " ++ language ++ "\t"
-formatLanguage Nothing = ""
diff --git a/samples/Repos/ShowRepo.hs b/samples/Repos/ShowRepo.hs
deleted file mode 100644
--- a/samples/Repos/ShowRepo.hs
+++ /dev/null
@@ -1,26 +0,0 @@
-module ShowRepo where
-
-import qualified Github.Repos as Github
-import Data.List
-import Data.Maybe
-
-main = do
- possibleRepo <- Github.userRepo "mike-burns" "trylambda"
- case possibleRepo of
- (Left error) -> putStrLn $ "Error: " ++ (show error)
- (Right repo) -> putStrLn $ formatRepo repo
-
-formatRepo repo =
- (Github.repoName repo) ++ "\t" ++
- (fromMaybe "" $ Github.repoDescription repo) ++ "\n" ++
- (Github.repoHtmlUrl repo) ++ "\n" ++
- (Github.repoCloneUrl repo) ++ "\t" ++
- (formatDate $ Github.repoUpdatedAt repo) ++ "\n" ++
- formatLanguage (Github.repoLanguage repo) ++
- "watchers: " ++ (show $ Github.repoWatchers repo) ++ "\t" ++
- "forks: " ++ (show $ Github.repoForks repo)
-
-formatDate = show . Github.fromGithubDate
-
-formatLanguage (Just language) = "language: " ++ language ++ "\t"
-formatLanguage Nothing = ""
diff --git a/samples/Repos/Starring/ListStarred.hs b/samples/Repos/Starring/ListStarred.hs
deleted file mode 100644
--- a/samples/Repos/Starring/ListStarred.hs
+++ /dev/null
@@ -1,25 +0,0 @@
-module ListStarred where
-
-import qualified Github.Repos.Starring as Github
-import Data.List (intercalate)
-import Data.Maybe (fromMaybe)
-
-main = do
- possibleRepos <- Github.reposStarredBy Nothing "mike-burns"
- putStrLn $ either (("Error: "++) . show)
- (intercalate "\n\n" . map formatRepo)
- possibleRepos
-
-formatRepo repo =
- (Github.repoName repo) ++ "\t" ++
- (fromMaybe "" $ Github.repoDescription repo) ++ "\n" ++
- (Github.repoHtmlUrl repo) ++ "\n" ++
- (fromMaybe "" $ Github.repoCloneUrl repo) ++ "\t" ++
- (formatDate $ Github.repoUpdatedAt repo) ++ "\n" ++
- formatLanguage (Github.repoLanguage repo)
-
-formatDate (Just date) = show . Github.fromGithubDate $ date
-formatDate Nothing = ""
-
-formatLanguage (Just language) = "language: " ++ language ++ "\t"
-formatLanguage Nothing = ""
diff --git a/samples/Repos/Watching/ListWatched.hs b/samples/Repos/Watching/ListWatched.hs
deleted file mode 100644
--- a/samples/Repos/Watching/ListWatched.hs
+++ /dev/null
@@ -1,27 +0,0 @@
-module ListWatched where
-
-import qualified Github.Repos.Watching as Github
-import Data.List (intercalate)
-import Data.Maybe (fromMaybe)
-
-main = do
- possibleRepos <- Github.reposWatchedBy "mike-burns"
- putStrLn $ either (("Error: "++) . show)
- (intercalate "\n\n" . map formatRepo)
- possibleRepos
-
-formatRepo repo =
- (Github.repoName repo) ++ "\t" ++
- (fromMaybe "" $ Github.repoDescription repo) ++ "\n" ++
- (Github.repoHtmlUrl repo) ++ "\n" ++
- (fromMaybe "" $ Github.repoCloneUrl repo) ++ "\t" ++
- (formatDate $ Github.repoUpdatedAt repo) ++ "\n" ++
- formatLanguage (Github.repoLanguage repo) ++
- "watchers: " ++ (show $ Github.repoWatchers repo) ++ "\t" ++
- "forks: " ++ (show $ Github.repoForks repo)
-
-formatDate (Just date) = show . Github.fromGithubDate $ date
-formatDate Nothing = ""
-
-formatLanguage (Just language) = "language: " ++ language ++ "\t"
-formatLanguage Nothing = ""
diff --git a/samples/Repos/Watching/ListWatchers.hs b/samples/Repos/Watching/ListWatchers.hs
deleted file mode 100644
--- a/samples/Repos/Watching/ListWatchers.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-module ListWatchers where
-
-import qualified Github.Repos.Watching as Github
-import Data.List (intercalate)
-
-main = do
- possibleWatchers <- Github.watchersFor "doubledrones" "git-annex"
- putStrLn $ either (("Error: "++) . show)
- (intercalate "\n" . map formatWatcher)
- possibleWatchers
-
-formatWatcher :: Github.GithubOwner -> String
-formatWatcher user =
- (Github.githubOwnerLogin user) ++ " (" ++ (Github.githubOwnerUrl user) ++ ")"
diff --git a/samples/Repos/Webhooks/CreateWebhook.hs b/samples/Repos/Webhooks/CreateWebhook.hs
deleted file mode 100644
--- a/samples/Repos/Webhooks/CreateWebhook.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-module CreateWebhook where
-
-import Github.Repos.Webhooks
-import qualified Github.Auth as Auth
-import Github.Data.Definitions
-import qualified Data.Map as M
-
-main :: IO ()
-main = do
- let auth = Auth.GithubOAuth "oauthtoken"
- let config = M.fromList [("url", "https://foo3.io"), ("content_type", "application/json"), ("insecure_ssl", "1")]
- let webhookDef = NewRepoWebhook {
- newRepoWebhookName = "web",
- newRepoWebhookConfig = config,
- newRepoWebhookEvents = Just [WebhookWildcardEvent],
- newRepoWebhookActive = Just True
- }
- newWebhook <- createRepoWebhook' auth "repoOwner" "repoName" webhookDef
- case newWebhook of
- (Left err) -> putStrLn $ "Error: " ++ (show err)
- (Right webhook) -> putStrLn $ formatRepoWebhook webhook
-
-formatRepoWebhook :: RepoWebhook -> String
-formatRepoWebhook (RepoWebhook _ _ _ name _ _ _ _ _ _) = show name
diff --git a/samples/Repos/Webhooks/DeleteWebhook.hs b/samples/Repos/Webhooks/DeleteWebhook.hs
deleted file mode 100644
--- a/samples/Repos/Webhooks/DeleteWebhook.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module DeleteWebhook where
-
-import Github.Repos.Webhooks
-import qualified Github.Auth as Auth
-
-main :: IO ()
-main = do
- let auth = Auth.GithubOAuth "oauthtoken"
- resp <- deleteRepoWebhook' auth "repoOwner" "repoName" 123
- case resp of
- (Left err) -> putStrLn $ "Error: " ++ (show err)
- (Right stat) -> putStrLn $ "Resp: " ++ (show stat)
diff --git a/samples/Repos/Webhooks/EditWebhook.hs b/samples/Repos/Webhooks/EditWebhook.hs
deleted file mode 100644
--- a/samples/Repos/Webhooks/EditWebhook.hs
+++ /dev/null
@@ -1,23 +0,0 @@
-module EditWebhook where
-
-import Github.Repos.Webhooks
-import qualified Github.Auth as Auth
-import Github.Data.Definitions
-
-main :: IO ()
-main = do
- let auth = Auth.GithubOAuth "oauthtoken"
- let editWebhookDef = EditRepoWebhook {
- editRepoWebhookRemoveEvents = Just [WebhookWildcardEvent],
- editRepoWebhookAddEvents = Just [WebhookCommitCommentEvent, WebhookGollumEvent],
- editRepoWebhookConfig = Nothing,
- editRepoWebhookEvents = Nothing,
- editRepoWebhookActive = Just True
- }
- newWebhook <- editRepoWebhook' auth "repoOwner" "repoName" 123 editWebhookDef
- case newWebhook of
- (Left err) -> putStrLn $ "Error: " ++ (show err)
- (Right webhook) -> putStrLn $ formatRepoWebhook webhook
-
-formatRepoWebhook :: RepoWebhook -> String
-formatRepoWebhook (RepoWebhook _ _ _ name _ _ _ _ _ _) = show name
diff --git a/samples/Repos/Webhooks/ListWebhook.hs b/samples/Repos/Webhooks/ListWebhook.hs
deleted file mode 100644
--- a/samples/Repos/Webhooks/ListWebhook.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-module ListWebhook where
-
-import qualified Github.Repos.Webhooks as W
-import qualified Github.Auth as Auth
-import qualified Github.Data.Definitions as Def
-
-main :: IO ()
-main = do
- let auth = Auth.GithubOAuth "oauthtoken"
- possibleWebhook <- W.webhookFor' auth "repoOwner" "repoName" 123
- case possibleWebhook of
- (Left err) -> putStrLn $ "Error: " ++ (show err)
- (Right webhook) -> putStrLn $ formatRepoWebhook webhook
-
-formatRepoWebhook :: Def.RepoWebhook -> String
-formatRepoWebhook (Def.RepoWebhook _ _ _ name _ _ _ _ _ _) = show name
diff --git a/samples/Repos/Webhooks/ListWebhooks.hs b/samples/Repos/Webhooks/ListWebhooks.hs
deleted file mode 100644
--- a/samples/Repos/Webhooks/ListWebhooks.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-module ListWebhooks where
-
-import qualified Github.Repos.Webhooks as W
-import qualified Github.Auth as Auth
-import qualified Github.Data.Definitions as Def
-import Data.List
-
-main :: IO ()
-main = do
- let auth = Auth.GithubOAuth "oauthtoken"
- possibleWebhooks <- W.webhooksFor' auth "repoOwner" "repoName"
- case possibleWebhooks of
- (Left err) -> putStrLn $ "Error: " ++ (show err)
- (Right webhooks) -> putStrLn $ intercalate "\n" $ map formatRepoWebhook webhooks
-
-formatRepoWebhook :: Def.RepoWebhook -> String
-formatRepoWebhook (Def.RepoWebhook _ _ _ name _ _ _ _ _ _) = show name
diff --git a/samples/Repos/Webhooks/PingWebhook.hs b/samples/Repos/Webhooks/PingWebhook.hs
deleted file mode 100644
--- a/samples/Repos/Webhooks/PingWebhook.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module PingWebhook where
-
-import Github.Repos.Webhooks
-import qualified Github.Auth as Auth
-
-main :: IO ()
-main = do
- let auth = Auth.GithubOAuth "oauthtoken"
- resp <- pingRepoWebhook' auth "repoOwner" "repoName" 123
- case resp of
- (Left err) -> putStrLn $ "Error: " ++ (show err)
- (Right stat) -> putStrLn $ "Resp: " ++ (show stat)
diff --git a/samples/Repos/Webhooks/TestPushWebhook.hs b/samples/Repos/Webhooks/TestPushWebhook.hs
deleted file mode 100644
--- a/samples/Repos/Webhooks/TestPushWebhook.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module TestPushWebhook where
-
-import Github.Repos.Webhooks
-import qualified Github.Auth as Auth
-
-main :: IO ()
-main = do
- let auth = Auth.GithubOAuth "oauthtoken"
- resp <- testPushRepoWebhook' auth "repoOwner" "repoName" 123
- case resp of
- (Left err) -> putStrLn $ "Error: " ++ (show err)
- (Right stat) -> putStrLn $ "Resp: " ++ (show stat)
diff --git a/samples/Search/SearchRepos.hs b/samples/Search/SearchRepos.hs
deleted file mode 100644
--- a/samples/Search/SearchRepos.hs
+++ /dev/null
@@ -1,56 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module SearchRepos where
-
-import qualified Github.Search as Github
-import qualified Github.Data as Github
-import Control.Monad (forM,forM_)
-import Data.Maybe (fromMaybe)
-import Data.List (intercalate)
-import System.Environment (getArgs)
-import Text.Printf (printf)
-import Data.Time.Clock (getCurrentTime, UTCTime(..))
-import Data.Time.LocalTime (utc,utcToLocalTime,localDay,localTimeOfDay,TimeOfDay(..))
-import Data.Time.Calendar (toGregorian)
-
-main = do
- args <- getArgs
- date <- case args of
- (x:_) -> return x
- otherwise -> today
- let query = "q=language%3Ahaskell created%3A>" ++ date ++ "&per_page=100"
- let auth = Nothing
- result <- Github.searchRepos' auth query
- case result of
- Left e -> putStrLn $ "Error: " ++ show e
- Right r -> do forM_ (Github.searchReposRepos r) (\r -> do
- putStrLn $ formatRepo r
- putStrLn ""
- )
- putStrLn $ "Count: " ++ show n ++ " Haskell repos created since " ++ date
- where n = Github.searchReposTotalCount r
-
--- | return today (in UTC) formatted as YYYY-MM-DD
-today :: IO String
-today = do
- now <- getCurrentTime
- let day = localDay $ utcToLocalTime utc now
- (y,m,d) = toGregorian day
- in return $ printf "%d-%02d-%02d" y m d
-
-formatRepo :: Github.Repo -> String
-formatRepo r =
- let fields = [ ("Name", Github.repoName)
- ,("URL", Github.repoHtmlUrl)
- ,("Description", orEmpty . Github.repoDescription)
- ,("Created-At", formatMaybeDate . Github.repoCreatedAt)
- ,("Pushed-At", formatMaybeDate . Github.repoPushedAt)
- ]
- in intercalate "\n" $ map fmt fields
- where fmt (s,f) = fill 12 (s ++ ":") ++ " " ++ f r
- orEmpty = fromMaybe ""
- fill n s = s ++ replicate n' ' '
- where n' = max 0 (n - length s)
-
-formatMaybeDate = maybe "???" formatDate
-
-formatDate = show . Github.fromGithubDate
diff --git a/samples/Users/Followers/ListFollowers.hs b/samples/Users/Followers/ListFollowers.hs
deleted file mode 100644
--- a/samples/Users/Followers/ListFollowers.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module ListFollowers where
-
-import qualified Github.Users.Followers as Github
-import Data.List (intercalate)
-
-main = do
- possibleUsers <- Github.usersFollowing "mike-burns"
- putStrLn $ either (("Error: "++) . show)
- (intercalate "\n" . map formatUser)
- possibleUsers
-
-formatUser = Github.githubOwnerLogin
diff --git a/samples/Users/Followers/ListFollowing.hs b/samples/Users/Followers/ListFollowing.hs
deleted file mode 100644
--- a/samples/Users/Followers/ListFollowing.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module ListFollowing where
-
-import qualified Github.Users.Followers as Github
-import Data.List (intercalate)
-
-main = do
- possibleUsers <- Github.usersFollowedBy "mike-burns"
- putStrLn $ either (("Error: "++) . show)
- (intercalate "\n" . map formatUser)
- possibleUsers
-
-formatUser = Github.githubOwnerLogin
-
diff --git a/samples/Users/ShowUser.hs b/samples/Users/ShowUser.hs
deleted file mode 100644
--- a/samples/Users/ShowUser.hs
+++ /dev/null
@@ -1,52 +0,0 @@
-module ShowUser where
-
-import qualified Github.Users as Github
-import Data.Maybe (fromMaybe)
-
-main = do
- possibleUser <- Github.userInfoFor "mike-burns"
- putStrLn $ either (("Error: "++) . show) formatUser possibleUser
-
-formatUser user@(Github.DetailedOrganization {}) =
- "Organization: " ++ (formatName userName login) ++ "\t" ++
- (fromMaybe "" company) ++ "\t" ++
- (fromMaybe "" location) ++ "\n" ++
- (fromMaybe "" blog) ++ "\t" ++ "\n" ++
- htmlUrl ++ "\t" ++ (formatDate createdAt) ++ "\n\n" ++
- (fromMaybe "" bio)
- where
- userName = Github.detailedOwnerName user
- login = Github.detailedOwnerLogin user
- company = Github.detailedOwnerCompany user
- location = Github.detailedOwnerLocation user
- blog = Github.detailedOwnerBlog user
- htmlUrl = Github.detailedOwnerHtmlUrl user
- createdAt = Github.detailedOwnerCreatedAt user
- bio = Github.detailedOwnerBio user
-
-formatUser user@(Github.DetailedUser {}) =
- (formatName userName login) ++ "\t" ++ (fromMaybe "" company) ++ "\t" ++
- (fromMaybe "" location) ++ "\n" ++
- (fromMaybe "" blog) ++ "\t" ++ "<" ++ (fromMaybe "" email) ++ ">" ++ "\n" ++
- htmlUrl ++ "\t" ++ (formatDate createdAt) ++ "\n" ++
- "hireable: " ++ (formatHireable (fromMaybe False isHireable)) ++ "\n\n" ++
- (fromMaybe "" bio)
- where
- userName = Github.detailedOwnerName user
- login = Github.detailedOwnerLogin user
- company = Github.detailedOwnerCompany user
- location = Github.detailedOwnerLocation user
- blog = Github.detailedOwnerBlog user
- email = Github.detailedOwnerEmail user
- htmlUrl = Github.detailedOwnerHtmlUrl user
- createdAt = Github.detailedOwnerCreatedAt user
- isHireable = Github.detailedOwnerHireable user
- bio = Github.detailedOwnerBio user
-
-formatName Nothing login = login
-formatName (Just name) login = name ++ "(" ++ login ++ ")"
-
-formatHireable True = "yes"
-formatHireable False = "no"
-
-formatDate = show . Github.fromGithubDate
diff --git a/spec/GitHub/ActivitySpec.hs b/spec/GitHub/ActivitySpec.hs
new file mode 100644
--- /dev/null
+++ b/spec/GitHub/ActivitySpec.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+module GitHub.ActivitySpec where
+
+import GitHub.Auth (Auth (..))
+import GitHub.Endpoints.Activity.Watching (watchersForR)
+import GitHub.Request (executeRequest)
+
+import Data.Either.Compat (isRight)
+import Data.String (fromString)
+import System.Environment (lookupEnv)
+import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy)
+
+import qualified Data.Vector as V
+
+fromRightS :: Show a => Either a b -> b
+fromRightS (Right b) = b
+fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a
+
+withAuth :: (Auth -> IO ()) -> IO ()
+withAuth action = do
+ mtoken <- lookupEnv "GITHUB_TOKEN"
+ case mtoken of
+ Nothing -> pendingWith "no GITHUB_TOKEN"
+ Just token -> action (OAuth $ fromString token)
+
+spec :: Spec
+spec = do
+ describe "watchersForR" $ do
+ it "works" $ withAuth $ \auth -> do
+ cs <- executeRequest auth $ watchersForR "phadej" "github" Nothing
+ cs `shouldSatisfy` isRight
+ V.length (fromRightS cs) `shouldSatisfy` (> 10)
diff --git a/spec/GitHub/CommitsSpec.hs b/spec/GitHub/CommitsSpec.hs
new file mode 100644
--- /dev/null
+++ b/spec/GitHub/CommitsSpec.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+module GitHub.CommitsSpec where
+
+import GitHub.Auth (Auth (..))
+import GitHub.Endpoints.Repos.Commits (Commit, commitSha, commitsFor',
+ commitsForR, diffR, mkName)
+import GitHub.Request (executeRequest)
+
+import Control.Monad (forM_)
+import Data.Either.Compat (isRight)
+import Data.List (nub, sort)
+import Data.Proxy (Proxy (..))
+import Data.String (fromString)
+import System.Environment (lookupEnv)
+import Test.Hspec (Spec, describe, it, pendingWith, shouldBe,
+ shouldSatisfy)
+
+import qualified Data.Vector as V
+
+fromRightS :: Show a => Either a b -> b
+fromRightS (Right b) = b
+fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a
+
+withAuth :: (Auth -> IO ()) -> IO ()
+withAuth action = do
+ mtoken <- lookupEnv "GITHUB_TOKEN"
+ case mtoken of
+ Nothing -> pendingWith "no GITHUB_TOKEN"
+ Just token -> action (OAuth $ fromString token)
+
+spec :: Spec
+spec = do
+ describe "commitsFor" $ do
+ it "works" $ withAuth $ \auth -> do
+ cs <- commitsFor' (Just auth) "phadej" "github"
+ cs `shouldSatisfy` isRight
+ V.length (fromRightS cs) `shouldSatisfy` (> 300)
+
+ -- Page size is 30, so we get 60 commits
+ it "limits the response" $ withAuth $ \auth -> do
+ cs <- executeRequest auth $ commitsForR "phadej" "github" (Just 40)
+ cs `shouldSatisfy` isRight
+ let cs' = fromRightS cs
+ V.length cs' `shouldSatisfy` (< 70)
+ let hashes = sort $ map commitSha $ V.toList cs'
+ hashes `shouldBe` nub hashes
+
+ describe "diff" $ do
+ it "works" $ withAuth $ \auth -> do
+ cs <- executeRequest auth $ commitsForR "phadej" "github" (Just 30)
+ cs `shouldSatisfy` isRight
+ let commits = take 10 . V.toList . fromRightS $ cs
+ let pairs = zip commits $ drop 1 commits
+ forM_ pairs $ \(a, b) -> do
+ d <- executeRequest auth $ diffR "phadej" "github" (commitSha a) (commitSha b)
+ d `shouldSatisfy` isRight
+
+ it "issue #155" $ withAuth $ \auth -> do
+ let mkCommitName = mkName (Proxy :: Proxy Commit)
+ d <- executeRequest auth $ diffR "nomeata" "codespeed" (mkCommitName "ghc") (mkCommitName "tobami:master")
+ d `shouldSatisfy` isRight
diff --git a/spec/GitHub/OrganizationsSpec.hs b/spec/GitHub/OrganizationsSpec.hs
new file mode 100644
--- /dev/null
+++ b/spec/GitHub/OrganizationsSpec.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+module GitHub.OrganizationsSpec where
+
+import GitHub.Auth (Auth (..))
+import GitHub.Data (SimpleOrganization (..),
+ SimpleOwner (..),
+ SimpleTeam (..))
+import GitHub.Endpoints.Organizations (publicOrganizationsFor')
+import GitHub.Endpoints.Organizations.Members (membersOf')
+
+import Data.Aeson.Compat (eitherDecodeStrict)
+import Data.Either.Compat (isRight)
+import Data.FileEmbed (embedFile)
+import Data.String (fromString)
+import System.Environment (lookupEnv)
+import Test.Hspec (Spec, describe, it, pendingWith, shouldBe,
+ shouldSatisfy)
+
+fromRightS :: Show a => Either a b -> b
+fromRightS (Right b) = b
+fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a
+
+withAuth :: (Auth -> IO ()) -> IO ()
+withAuth action = do
+ mtoken <- lookupEnv "GITHUB_TOKEN"
+ case mtoken of
+ Nothing -> pendingWith "no GITHUB_TOKEN"
+ Just token -> action (OAuth $ fromString token)
+
+spec :: Spec
+spec = do
+ describe "publicOrganizationsFor'" $ do
+ it "decodes simple organization json" $ do
+ let orgs = eitherDecodeStrict $(embedFile "fixtures/user-organizations.json")
+ simpleOrganizationLogin (head $ fromRightS orgs) `shouldBe` "github"
+
+ it "returns information about the user's organizations" $ withAuth $ \auth -> do
+ orgs <- publicOrganizationsFor' (Just auth) "mike-burns"
+ orgs `shouldSatisfy` isRight
+
+ describe "teamsOf" $ do
+ it "parse" $ do
+ let ts = eitherDecodeStrict $(embedFile "fixtures/list-teams.json")
+ simpleTeamName (head $ fromRightS ts) `shouldBe` "Justice League"
+
+ describe "membersOf" $ do
+ it "parse" $ do
+ let ms = eitherDecodeStrict $(embedFile "fixtures/members-list.json")
+ simpleOwnerLogin (head $ fromRightS ms) `shouldBe` "octocat"
+
+ it "works" $ withAuth $ \auth -> do
+ ms <- membersOf' (Just auth) "haskell"
+ ms `shouldSatisfy` isRight
diff --git a/spec/GitHub/ReposSpec.hs b/spec/GitHub/ReposSpec.hs
new file mode 100644
--- /dev/null
+++ b/spec/GitHub/ReposSpec.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+module GitHub.ReposSpec where
+
+import GitHub.Auth (Auth (..))
+import GitHub.Endpoints.Repos (RepoPublicity (..), currentUserRepos,
+ languagesFor', userRepos')
+
+import Data.Either.Compat (isRight)
+import Data.String (fromString)
+import System.Environment (lookupEnv)
+import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy)
+
+import qualified Data.HashMap.Strict as HM
+
+fromRightS :: Show a => Either a b -> b
+fromRightS (Right b) = b
+fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a
+
+withAuth :: (Auth -> IO ()) -> IO ()
+withAuth action = do
+ mtoken <- lookupEnv "GITHUB_TOKEN"
+ case mtoken of
+ Nothing -> pendingWith "no GITHUB_TOKEN"
+ Just token -> action (OAuth $ fromString token)
+
+spec :: Spec
+spec = do
+ describe "currentUserRepos" $ do
+ it "works" $ withAuth $ \auth -> do
+ cs <- currentUserRepos auth RepoPublicityAll
+ cs `shouldSatisfy` isRight
+
+ describe "userRepos" $ do
+ it "works" $ withAuth $ \auth -> do
+ cs <- userRepos' (Just auth) "phadej" RepoPublicityAll
+ cs `shouldSatisfy` isRight
+
+ describe "languagesFor'" $ do
+ it "works" $ withAuth $ \auth -> do
+ ls <- languagesFor' (Just auth) "phadej" "github"
+ ls `shouldSatisfy` isRight
+ fromRightS ls `shouldSatisfy` HM.member "Haskell"
diff --git a/spec/GitHub/SearchSpec.hs b/spec/GitHub/SearchSpec.hs
new file mode 100644
--- /dev/null
+++ b/spec/GitHub/SearchSpec.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+module GitHub.SearchSpec where
+
+import Prelude ()
+import Prelude.Compat
+
+import Data.Aeson.Compat (eitherDecodeStrict)
+import Data.FileEmbed (embedFile)
+import Test.Hspec (Spec, describe, it, shouldBe)
+
+import qualified Data.Vector as V
+
+import GitHub.Data.Id (Id (..))
+import GitHub.Data.Issues (Issue (..))
+import GitHub.Endpoints.Search (SearchResult (..), searchIssues)
+
+fromRightS :: Show a => Either a b -> b
+fromRightS (Right b) = b
+fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a
+
+spec :: Spec
+spec = do
+ describe "searchIssues" $ do
+ it "decodes issue search response JSON" $ do
+ let searchIssuesResult = fromRightS $ eitherDecodeStrict $(embedFile "fixtures/issue-search.json") :: SearchResult Issue
+ searchResultTotalCount searchIssuesResult `shouldBe` 2
+
+ let issues = searchResultResults searchIssuesResult
+ V.length issues `shouldBe` 2
+
+ let issue1 = issues V.! 0
+ issueId issue1 `shouldBe` Id 123898390
+ issueNumber issue1 `shouldBe` 130
+ issueTitle issue1 `shouldBe` "Make test runner more robust"
+ issueState issue1 `shouldBe` "closed"
+
+ let issue2 = issues V.! 1
+ issueId issue2 `shouldBe` Id 119694665
+ issueNumber issue2 `shouldBe` 127
+ issueTitle issue2 `shouldBe` "Decouple request creation from execution"
+ issueState issue2 `shouldBe` "open"
+
+ it "performs an issue search via the API" $ do
+ let query = "Decouple in:title repo:phadej/github created:<=2015-12-01"
+ issues <- searchResultResults . fromRightS <$> searchIssues query
+ length issues `shouldBe` 1
+ issueId (V.head issues) `shouldBe` Id 119694665
diff --git a/spec/GitHub/UsersSpec.hs b/spec/GitHub/UsersSpec.hs
new file mode 100644
--- /dev/null
+++ b/spec/GitHub/UsersSpec.hs
@@ -0,0 +1,76 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+module GitHub.UsersSpec where
+
+import Data.Aeson.Compat (eitherDecodeStrict)
+import Data.Either.Compat (isLeft, isRight)
+import Data.FileEmbed (embedFile)
+import Data.String (fromString)
+import System.Environment (lookupEnv)
+import Test.Hspec (Spec, describe, it, pendingWith, shouldBe,
+ shouldSatisfy)
+
+import GitHub.Data (Auth (..), Organization (..),
+ User (..), fromOwner)
+import GitHub.Endpoints.Users (ownerInfoForR, userInfoCurrent',
+ userInfoFor')
+import GitHub.Endpoints.Users.Followers (usersFollowedByR, usersFollowingR)
+import GitHub.Request (executeRequest)
+
+fromRightS :: Show a => Either a b -> b
+fromRightS (Right b) = b
+fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a
+
+fromLeftS :: Show b => Either a b -> a
+fromLeftS (Left b) = b
+fromLeftS (Right a) = error $ "Expected a Left and got a RIght" ++ show a
+
+withAuth :: (Auth -> IO ()) -> IO ()
+withAuth action = do
+ mtoken <- lookupEnv "GITHUB_TOKEN"
+ case mtoken of
+ Nothing -> pendingWith "no GITHUB_TOKEN"
+ Just token -> action (OAuth $ fromString token)
+
+spec :: Spec
+spec = do
+ describe "userInfoFor" $ do
+ it "decodes user json" $ do
+ let userInfo = eitherDecodeStrict $(embedFile "fixtures/user.json")
+ userLogin (fromRightS userInfo) `shouldBe` "mike-burns"
+
+ it "returns information about the user" $ withAuth $ \auth -> do
+ userInfo <- userInfoFor' (Just auth) "mike-burns"
+ userLogin (fromRightS userInfo) `shouldBe` "mike-burns"
+
+ it "catches http exceptions" $ withAuth $ \auth -> do
+ userInfo <- userInfoFor' (Just auth) "i-hope-this-user-will-never-exist"
+ userInfo `shouldSatisfy` isLeft
+
+ it "should fail for organization" $ withAuth $ \auth -> do
+ userInfo <- userInfoFor' (Just auth) "haskell"
+ userInfo `shouldSatisfy` isLeft
+
+ describe "ownerInfoFor" $ do
+ it "works for users and organizations" $ withAuth $ \auth -> do
+ a <- executeRequest auth $ ownerInfoForR "haskell"
+ b <- executeRequest auth $ ownerInfoForR "phadej"
+ a `shouldSatisfy` isRight
+ b `shouldSatisfy` isRight
+ (organizationLogin . fromRightS . fromOwner . fromRightS $ a) `shouldBe` "haskell"
+ (userLogin . fromLeftS . fromOwner . fromRightS $ b) `shouldBe` "phadej"
+
+ describe "userInfoCurrent'" $ do
+ it "returns information about the autenticated user" $ withAuth $ \auth -> do
+ userInfo <- userInfoCurrent' auth
+ userInfo `shouldSatisfy` isRight
+
+ describe "usersFollowing" $ do
+ it "works" $ withAuth $ \auth -> do
+ us <- executeRequest auth $ usersFollowingR "phadej" (Just 10)
+ us `shouldSatisfy` isRight
+
+ describe "usersFollowedBy" $ do
+ it "works" $ withAuth $ \auth -> do
+ us <- executeRequest auth $ usersFollowedByR "phadej" (Just 10)
+ us `shouldSatisfy` isRight
diff --git a/src/GitHub.hs b/src/GitHub.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub.hs
@@ -0,0 +1,335 @@
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- This module re-exports all request constructrors and data definitions from
+-- this package.
+--
+-- See "GitHub.Request" module for executing 'Request', or other modules
+-- of this package (e.g. "GitHub.Users") for already composed versions.
+--
+-- The missing endpoints lists show which endpoints we know are missing, there
+-- might be more.
+module GitHub (
+ -- * Activity
+ -- | See
+
+ -- ** Starring
+ -- | See
+ --
+ -- Missing endpoints:
+ --
+ -- * Check if you are starring a repository
+ -- * Star a repository
+ -- * Unstar a repository
+ stargazersForR,
+ reposStarredByR,
+ myStarredR,
+
+ -- ** Watching
+ -- | See
+ --
+ -- Missing endpoints:
+ --
+ -- * Query a Repository Subscription
+ -- * Set a Repository Subscription
+ -- * Delete a Repository Subscription
+ watchersForR,
+ reposWatchedByR,
+
+ -- * Gists
+ -- | See
+ --
+ -- Missing endpoints:
+ --
+ -- * Query a specific revision of a gist
+ -- * Create a gist
+ -- * Edit a gist
+ -- * List gist commits
+ -- * Star a gist
+ -- * Unstar a gist
+ -- * Check if a gist is starred
+ -- * Fork a gist
+ -- * List gist forks
+ -- * Delete a gist
+ gistsR,
+ gistR,
+
+ -- ** Comments
+ -- | See
+ --
+ -- Missing endpoints:
+ -- * Create a comment
+ -- * Edit a comment
+ -- * Delete a comment
+ commentsOnR,
+ gistCommentR,
+
+ -- * Git Data
+ -- | See
+
+ -- ** Blobs
+ -- | See
+ blobR,
+
+ -- ** Commits
+ -- | See
+ gitCommitR,
+
+ -- ** References
+ -- | See
+ referenceR,
+ referencesR,
+ createReferenceR,
+
+ -- ** Trees
+ -- | See
+ treeR,
+ nestedTreeR,
+
+ -- * Issues
+ -- | See
+ --
+ -- Missing endpoints:
+ --
+ -- * List issues
+ issueR,
+ issuesForRepoR,
+ createIssueR,
+ editIssueR,
+
+ -- ** Comments
+ -- | See
+ --
+ -- Missing endpoints:
+ --
+ -- * Delete comment
+ commentR,
+ commentsR,
+ createCommentR,
+ editCommentR,
+
+ -- ** Events
+ -- | See
+ --
+ eventsForIssueR,
+ eventsForRepoR,
+ eventR,
+
+ -- ** Labels
+ -- | See
+ --
+ labelsOnRepoR,
+ labelR,
+ createLabelR,
+ updateLabelR,
+ deleteLabelR,
+ labelsOnIssueR,
+ addLabelsToIssueR,
+ removeLabelFromIssueR,
+ replaceAllLabelsForIssueR,
+ removeAllLabelsFromIssueR,
+ labelsOnMilestoneR,
+
+ -- ** Milestone
+ -- | See
+ --
+ -- Missing endpoints:
+ --
+ -- * Create a milestone
+ -- * Update a milestone
+ -- * Delete a milestone
+ milestonesR,
+ milestoneR,
+
+ -- * Organizations
+ -- | See
+ --
+ -- Missing endpoints:
+ --
+ -- * List your organizations
+ -- * List all organizations
+ -- * Edit an organization
+ publicOrganizationsForR,
+ publicOrganizationR,
+ -- ** Members
+ -- | See
+ --
+ -- Missing endpoints: All except /Members List/
+ membersOfR,
+
+ -- ** Teams
+ -- | See
+ --
+ -- Missing endpoints:
+ --
+ -- * List team members
+ -- * Query team member (deprecated)
+ -- * Add team member (deprecated)
+ -- * Remove team member (deprecated)
+ -- * List team repos
+ -- * Check if a team manages a repository
+ -- * Add team repository
+ -- * Remove team repository
+ teamsOfR,
+ teamInfoForR,
+ createTeamForR,
+ editTeamR,
+ deleteTeamR,
+ teamMembershipInfoForR,
+ addTeamMembershipForR,
+ deleteTeamMembershipForR,
+ listTeamsCurrentR,
+
+ -- * Pull Requests
+ -- | See
+ pullRequestsForR,
+ pullRequestR,
+ createPullRequestR,
+ updatePullRequestR,
+ pullRequestCommitsR,
+ pullRequestFilesR,
+ isPullRequestMergedR,
+ mergePullRequestR,
+
+ -- ** Review comments
+ -- | See
+ --
+ -- Missing endpoints:
+ --
+ -- * List comments in a repository
+ -- * Create a comment
+ -- * Edit a comment
+ -- * Delete a comment
+ pullRequestReviewCommentsR,
+ pullRequestReviewCommentR,
+
+ -- * Repositories
+ -- | See
+ --
+ -- Missing endpoints:
+ --
+ -- * List all public repositories
+ -- * List Teams
+ -- * Query Branch
+ -- * Enabling and disabling branch protection
+ currentUserReposR,
+ userReposR,
+ organizationReposR,
+ repositoryR,
+ contributorsR,
+ languagesForR,
+ tagsForR,
+ branchesForR,
+
+ -- ** Collaborators
+ -- | See
+ collaboratorsOnR,
+ isCollaboratorOnR,
+
+ -- ** Comments
+ -- | See
+ --
+ -- Missing endpoints:
+ --
+ -- * Create a commit comment
+ -- * Update a commit comment
+ -- * Delete a commit comment
+ commentsForR,
+ commitCommentsForR,
+ commitCommentForR,
+
+ -- ** Commits
+ -- | See
+ commitsForR,
+ commitsWithOptionsForR,
+ commitR,
+ diffR,
+
+ -- ** Forks
+ -- | See
+ --
+ -- Missing endpoints:
+ --
+ -- * Create a fork
+ forksForR,
+
+ -- ** Webhooks
+ -- | See
+ webhooksForR,
+ webhookForR,
+ createRepoWebhookR,
+ editRepoWebhookR,
+ testPushRepoWebhookR,
+ pingRepoWebhookR,
+ deleteRepoWebhookR,
+
+ -- * Search
+ -- | See
+ --
+ -- Missing endpoints:
+ --
+ -- * Search users
+ searchReposR,
+ searchCodeR,
+ searchIssuesR,
+
+ -- * Users
+ -- | See
+ --
+ -- Missing endpoints:
+ --
+ -- * Update the authenticated user
+ -- * Query all users
+ userInfoForR,
+ ownerInfoForR,
+ userInfoCurrentR,
+
+ -- ** Followers
+ -- | See
+ --
+ -- Missing endpoints:
+ --
+ -- * Check if you are following a user
+ -- * Check if one user follows another
+ -- * Follow a user
+ -- * Unfollow a user
+ usersFollowingR,
+ usersFollowedByR,
+
+ -- * Data definitions
+ module GitHub.Data,
+ -- * Request handling
+ module GitHub.Request,
+ ) where
+
+import GitHub.Data
+import GitHub.Endpoints.Activity.Starring
+import GitHub.Endpoints.Activity.Watching
+import GitHub.Endpoints.Gists
+import GitHub.Endpoints.Gists.Comments
+import GitHub.Endpoints.GitData.Blobs
+import GitHub.Endpoints.GitData.Commits
+import GitHub.Endpoints.GitData.References
+import GitHub.Endpoints.GitData.Trees
+import GitHub.Endpoints.Issues
+import GitHub.Endpoints.Issues.Comments
+import GitHub.Endpoints.Issues.Events
+import GitHub.Endpoints.Issues.Labels
+import GitHub.Endpoints.Issues.Milestones
+import GitHub.Endpoints.Organizations
+import GitHub.Endpoints.Organizations.Members
+import GitHub.Endpoints.Organizations.Teams
+import GitHub.Endpoints.PullRequests
+import GitHub.Endpoints.PullRequests.ReviewComments
+import GitHub.Endpoints.Repos
+import GitHub.Endpoints.Repos.Collaborators
+import GitHub.Endpoints.Repos.Comments
+import GitHub.Endpoints.Repos.Commits
+import GitHub.Endpoints.Repos.Forks
+import GitHub.Endpoints.Repos.Webhooks
+import GitHub.Endpoints.Search
+import GitHub.Endpoints.Users
+import GitHub.Endpoints.Users.Followers
+import GitHub.Request
diff --git a/src/GitHub/Auth.hs b/src/GitHub/Auth.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Auth.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+module GitHub.Auth where
+
+import Control.DeepSeq (NFData (..))
+import Control.DeepSeq.Generics (genericRnf)
+import Data.Binary (Binary)
+import Data.Data (Data, Typeable)
+import GHC.Generics (Generic)
+
+import qualified Data.ByteString as BS
+
+type Token = BS.ByteString
+
+-- | The Github auth data type
+data Auth
+ = BasicAuth BS.ByteString BS.ByteString
+ | OAuth Token -- ^ token
+ | EnterpriseOAuth String -- custom API endpoint without
+ -- trailing slash
+ Token -- token
+ deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData Auth where rnf = genericRnf
+instance Binary Auth
diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Data.hs
@@ -0,0 +1,95 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE OverloadedStrings #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- This module re-exports the @GitHub.Data.@ and "Github.Auth" submodules.
+module GitHub.Data (
+ -- * Tagged types
+ -- ** Name
+ Name,
+ mkName,
+ untagName,
+ mkOwnerName,
+ mkTeamName,
+ mkOrganizationName,
+ mkRepoName,
+ fromUserName,
+ fromOrganizationName,
+ -- ** Id
+ Id,
+ mkId,
+ untagId,
+ mkOwnerId,
+ mkTeamId,
+ mkOrganizationId,
+ mkRepoId,
+ -- * Module re-exports
+ module GitHub.Auth,
+ module GitHub.Data.Comments,
+ module GitHub.Data.Content,
+ module GitHub.Data.Definitions,
+ module GitHub.Data.Gists,
+ module GitHub.Data.GitData,
+ module GitHub.Data.Issues,
+ module GitHub.Data.PullRequests,
+ module GitHub.Data.Repos,
+ module GitHub.Data.Request,
+ module GitHub.Data.Search,
+ module GitHub.Data.Teams,
+ module GitHub.Data.Webhooks,
+ ) where
+
+import Prelude ()
+import Prelude.Compat
+
+import Data.Text (Text)
+
+import GitHub.Auth
+import GitHub.Data.Comments
+import GitHub.Data.Content
+import GitHub.Data.Definitions
+import GitHub.Data.Gists
+import GitHub.Data.GitData
+import GitHub.Data.Id
+import GitHub.Data.Issues
+import GitHub.Data.Name
+import GitHub.Data.PullRequests
+import GitHub.Data.Repos
+import GitHub.Data.Request
+import GitHub.Data.Search
+import GitHub.Data.Teams
+import GitHub.Data.Webhooks
+
+mkOwnerId :: Int -> Id Owner
+mkOwnerId = Id
+
+mkOwnerName :: Text -> Name Owner
+mkOwnerName = N
+
+mkTeamId :: Int -> Id Team
+mkTeamId = Id
+
+mkTeamName :: Text -> Name Team
+mkTeamName = N
+
+mkOrganizationId :: Int -> Id Organization
+mkOrganizationId = Id
+
+mkOrganizationName :: Text -> Name Organization
+mkOrganizationName = N
+
+mkRepoId :: Int -> Id Repo
+mkRepoId = Id
+
+mkRepoName :: Text -> Name Repo
+mkRepoName = N
+
+fromOrganizationName :: Name Organization -> Name Owner
+fromOrganizationName = N . untagName
+
+fromUserName :: Name User -> Name Owner
+fromUserName = N . untagName
diff --git a/src/GitHub/Data/Comments.hs b/src/GitHub/Data/Comments.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Data/Comments.hs
@@ -0,0 +1,76 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+module GitHub.Data.Comments where
+
+import Prelude ()
+import Prelude.Compat
+
+import Control.DeepSeq (NFData (..))
+import Control.DeepSeq.Generics (genericRnf)
+import Data.Aeson.Compat (FromJSON (..), ToJSON (..), object, withObject,
+ (.:), (.:?), (.=))
+import Data.Binary.Orphans (Binary)
+import Data.Data (Data, Typeable)
+import Data.Text (Text)
+import Data.Time (UTCTime)
+import GHC.Generics (Generic)
+
+import GitHub.Data.Definitions
+import GitHub.Data.Id
+
+data Comment = Comment {
+ commentPosition :: !(Maybe Int)
+ ,commentLine :: !(Maybe Int)
+ ,commentBody :: !Text
+ ,commentCommitId :: !(Maybe Text)
+ ,commentUpdatedAt :: !UTCTime
+ ,commentHtmlUrl :: !(Maybe Text)
+ ,commentUrl :: !Text
+ ,commentCreatedAt :: !(Maybe UTCTime)
+ ,commentPath :: !(Maybe Text)
+ ,commentUser :: !SimpleUser
+ ,commentId :: !(Id Comment)
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData Comment where rnf = genericRnf
+instance Binary Comment
+
+instance FromJSON Comment where
+ parseJSON = withObject "Comment" $ \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"
+
+data NewComment = NewComment {
+ newCommentBody :: !Text
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData NewComment where rnf = genericRnf
+instance Binary NewComment
+
+instance ToJSON NewComment where
+ toJSON (NewComment b) = object [ "body" .= b ]
+
+data EditComment = EditComment {
+ editCommentBody :: !Text
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData EditComment where rnf = genericRnf
+instance Binary EditComment
+
+instance ToJSON EditComment where
+ toJSON (EditComment b) = object [ "body" .= b ]
diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Data/Content.hs
@@ -0,0 +1,103 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+module GitHub.Data.Content where
+
+import Prelude ()
+import Prelude.Compat
+
+import Control.DeepSeq (NFData (..))
+import Control.DeepSeq.Generics (genericRnf)
+import Data.Aeson.Compat (FromJSON (..), Value (..), withObject,
+ withText, (.:))
+import Data.Binary.Orphans (Binary)
+import Data.Data (Data, Typeable)
+import Data.Text (Text)
+import Data.Vector (Vector)
+import GHC.Generics (Generic)
+
+import qualified Data.Text as T
+
+data Content
+ = ContentFile !ContentFileData
+ | ContentDirectory !(Vector ContentItem)
+ deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData Content where rnf = genericRnf
+instance Binary Content
+
+data ContentFileData = ContentFileData {
+ contentFileInfo :: !ContentInfo
+ ,contentFileEncoding :: !Text
+ ,contentFileSize :: !Int
+ ,contentFileContent :: !Text
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData ContentFileData where rnf = genericRnf
+instance Binary ContentFileData
+
+-- | An item in a directory listing.
+data ContentItem = ContentItem {
+ contentItemType :: !ContentItemType
+ ,contentItemInfo :: !ContentInfo
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData ContentItem where rnf = genericRnf
+instance Binary ContentItem
+
+data ContentItemType = ItemFile | ItemDir
+ deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData ContentItemType where rnf = genericRnf
+instance Binary ContentItemType
+
+-- | Information common to both kinds of Content: files and directories.
+data ContentInfo = ContentInfo {
+ contentName :: !Text
+ ,contentPath :: !Text
+ ,contentSha :: !Text
+ ,contentUrl :: !Text
+ ,contentGitUrl :: !Text
+ ,contentHtmlUrl :: !Text
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData ContentInfo where rnf = genericRnf
+instance Binary ContentInfo
+
+instance FromJSON Content where
+ parseJSON o@(Object _) = ContentFile <$> parseJSON o
+ parseJSON (Array os) = ContentDirectory <$> traverse parseJSON os
+ parseJSON _ = fail "Could not build a Content"
+
+instance FromJSON ContentFileData where
+ parseJSON = withObject "ContentFileData" $ \o ->
+ ContentFileData <$> parseJSON (Object o)
+ <*> o .: "encoding"
+ <*> o .: "size"
+ <*> o .: "content"
+
+instance FromJSON ContentItem where
+ parseJSON = withObject "ContentItem" $ \o ->
+ ContentItem <$> o .: "type"
+ <*> parseJSON (Object o)
+
+instance FromJSON ContentItemType where
+ parseJSON = withText "ContentItemType" $ \t ->
+ case t of
+ "file" -> return ItemFile
+ "dir" -> return ItemDir
+ _ -> fail $ "Invalid ContentItemType: " ++ T.unpack t
+
+instance FromJSON ContentInfo where
+ parseJSON = withObject "ContentInfo" $ \o ->
+ ContentInfo <$> o .: "name"
+ <*> o .: "path"
+ <*> o .: "sha"
+ <*> o .: "url"
+ <*> o .: "git_url"
+ <*> o .: "html_url"
diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Data/Definitions.hs
@@ -0,0 +1,231 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+module GitHub.Data.Definitions where
+
+import Prelude ()
+import Prelude.Compat
+
+import Control.DeepSeq (NFData (..))
+import Control.DeepSeq.Generics (genericRnf)
+import Control.Monad (mfilter)
+import Data.Aeson.Compat (FromJSON (..), Object, withObject, withText,
+ (.:), (.:?))
+import Data.Aeson.Types (Parser)
+import Data.Binary.Orphans (Binary)
+import Data.Data (Data, Typeable)
+import Data.Text (Text)
+import Data.Time (UTCTime)
+import GHC.Generics (Generic)
+import Network.HTTP.Client (HttpException)
+
+import qualified Control.Exception as E
+import qualified Data.Text as T
+
+import GitHub.Data.Id
+import GitHub.Data.Name
+
+-- | Errors have been tagged according to their source, so you can more easily
+-- dispatch and handle them.
+data Error
+ = HTTPError !HttpException -- ^ A HTTP error occurred. The actual caught error is included.
+ | ParseError !Text -- ^ An error in the parser itself.
+ | JsonError !Text -- ^ The JSON is malformed or unexpected.
+ | UserError !Text -- ^ Incorrect input.
+ deriving (Show, Typeable)
+
+instance E.Exception Error
+
+-- | Type of the repository owners.
+data OwnerType = OwnerUser | OwnerOrganization
+ deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable, Data)
+
+instance NFData OwnerType
+instance Binary OwnerType
+
+data SimpleUser = SimpleUser
+ { simpleUserId :: !(Id User)
+ , simpleUserLogin :: !(Name User)
+ , simpleUserAvatarUrl :: !Text
+ , simpleUserUrl :: !Text
+ , simpleUserType :: !OwnerType -- ^ Should always be 'OwnerUser'
+ }
+ deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData SimpleUser where rnf = genericRnf
+instance Binary SimpleUser
+
+data SimpleOrganization = SimpleOrganization
+ { simpleOrganizationId :: !(Id Organization)
+ , simpleOrganizationLogin :: !(Name Organization)
+ , simpleOrganizationUrl :: !Text
+ , simpleOrganizationAvatarUrl :: !Text
+ }
+ deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData SimpleOrganization where rnf = genericRnf
+instance Binary SimpleOrganization
+
+-- | Sometimes we don't know the type of the owner, e.g. in 'Repo'
+data SimpleOwner = SimpleOwner
+ { simpleOwnerId :: !(Id Owner)
+ , simpleOwnerLogin :: !(Name Owner)
+ , simpleOwnerUrl :: !Text
+ , simpleOwnerAvatarUrl :: !Text
+ , simpleOwnerType :: !OwnerType
+ }
+ deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData SimpleOwner where rnf = genericRnf
+instance Binary SimpleOwner
+
+data User = User
+ { userId :: !(Id User)
+ , userLogin :: !(Name User)
+ , userName :: !(Maybe Text)
+ , userType :: !OwnerType -- ^ Should always be 'OwnerUser'
+ , userCreatedAt :: !UTCTime
+ , userPublicGists :: !Int
+ , userAvatarUrl :: !Text
+ , userFollowers :: !Int
+ , userFollowing :: !Int
+ , userHireable :: !(Maybe Bool)
+ , userBlog :: !(Maybe Text)
+ , userBio :: !(Maybe Text)
+ , userPublicRepos :: !Int
+ , userLocation :: !(Maybe Text)
+ , userCompany :: !(Maybe Text)
+ , userEmail :: !(Maybe Text)
+ , userUrl :: !Text
+ , userHtmlUrl :: !Text
+ }
+ deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData User where rnf = genericRnf
+instance Binary User
+
+data Organization = Organization
+ { organizationId :: !(Id Organization)
+ , organizationLogin :: !(Name Organization)
+ , organizationName :: !(Maybe Text)
+ , organizationType :: !OwnerType -- ^ Should always be 'OwnerOrganization'
+ , organizationBlog :: !(Maybe Text)
+ , organizationLocation :: !(Maybe Text)
+ , organizationFollowers :: !Int
+ , organizationCompany :: !(Maybe Text)
+ , organizationAvatarUrl :: !Text
+ , organizationPublicGists :: !Int
+ , organizationHtmlUrl :: !Text
+ , organizationEmail :: !(Maybe Text)
+ , organizationFollowing :: !Int
+ , organizationPublicRepos :: !Int
+ , organizationUrl :: !Text
+ , organizationCreatedAt :: !UTCTime
+ }
+ deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData Organization where rnf = genericRnf
+instance Binary Organization
+
+-- | In practic, you cam't have concrete values of 'Owner'.
+newtype Owner = Owner (Either User Organization)
+ deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData Owner where rnf = genericRnf
+instance Binary Owner
+
+fromOwner :: Owner -> Either User Organization
+fromOwner (Owner owner) = owner
+
+-- JSON instances
+
+instance FromJSON OwnerType where
+ parseJSON = withText "Owner type" $ \t ->
+ case t of
+ "User" -> pure $ OwnerUser
+ "Organization" -> pure $ OwnerOrganization
+ _ -> fail $ "Unknown owner type: " ++ T.unpack t
+
+instance FromJSON SimpleUser where
+ parseJSON = withObject "SimpleUser" $ \obj -> do
+ SimpleUser
+ <$> obj .: "id"
+ <*> obj .: "login"
+ <*> obj .: "avatar_url"
+ <*> obj .: "url"
+ <*> obj .: "type"
+
+instance FromJSON SimpleOrganization where
+ parseJSON = withObject "SimpleOrganization" $ \obj ->
+ SimpleOrganization
+ <$> obj .: "id"
+ <*> obj .: "login"
+ <*> obj .: "url"
+ <*> obj .: "avatar_url"
+
+instance FromJSON SimpleOwner where
+ parseJSON = withObject "SimpleOwner" $ \obj -> do
+ SimpleOwner
+ <$> obj .: "id"
+ <*> obj .: "login"
+ <*> obj .: "url"
+ <*> obj .: "avatar_url"
+ <*> obj .: "type"
+
+parseUser :: Object -> Parser User
+parseUser obj = User
+ <$> obj .: "id"
+ <*> obj .: "login"
+ <*> obj .:? "name"
+ <*> obj .: "type"
+ <*> obj .: "created_at"
+ <*> obj .: "public_gists"
+ <*> obj .: "avatar_url"
+ <*> obj .: "followers"
+ <*> obj .: "following"
+ <*> obj .:? "hireable"
+ <*> obj .:? "blog"
+ <*> obj .:? "bio"
+ <*> obj .: "public_repos"
+ <*> obj .:? "location"
+ <*> obj .:? "company"
+ <*> obj .:? "email"
+ <*> obj .: "url"
+ <*> obj .: "html_url"
+
+parseOrganization :: Object -> Parser Organization
+parseOrganization obj = Organization
+ <$> obj .: "id"
+ <*> obj .: "login"
+ <*> obj .:? "name"
+ <*> obj .: "type"
+ <*> obj .:? "blog"
+ <*> obj .:? "location"
+ <*> obj .: "followers"
+ <*> obj .:? "company"
+ <*> obj .: "avatar_url"
+ <*> obj .: "public_gists"
+ <*> obj .: "html_url"
+ <*> obj .:? "email"
+ <*> obj .: "following"
+ <*> obj .: "public_repos"
+ <*> obj .: "url"
+ <*> obj .: "created_at"
+
+instance FromJSON User where
+ parseJSON = mfilter ((== OwnerUser) . userType) . withObject "User" parseUser
+
+instance FromJSON Organization where
+ parseJSON = withObject "Organization" parseOrganization
+
+instance FromJSON Owner where
+ parseJSON = withObject "Owner" $ \obj -> do
+ t <- obj .: "type"
+ case t of
+ OwnerUser -> Owner . Left <$> parseUser obj
+ OwnerOrganization -> Owner . Right <$> parseOrganization obj
diff --git a/src/GitHub/Data/Gists.hs b/src/GitHub/Data/Gists.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Data/Gists.hs
@@ -0,0 +1,102 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+module GitHub.Data.Gists where
+
+import Prelude ()
+import Prelude.Compat
+
+import GitHub.Data.Definitions
+import GitHub.Data.Id (Id)
+import GitHub.Data.Name (Name)
+import GitHub.Data.Repos (Language)
+
+import Control.DeepSeq (NFData (..))
+import Control.DeepSeq.Generics (genericRnf)
+import Data.Aeson.Compat (FromJSON (..), withObject, (.:), (.:?))
+import Data.Binary (Binary)
+import Data.Data (Data, Typeable)
+import Data.HashMap.Strict (HashMap)
+import Data.Text (Text)
+import Data.Time (UTCTime)
+import GHC.Generics (Generic)
+
+data Gist = Gist {
+ gistUser :: !SimpleUser
+ ,gistGitPushUrl :: !Text
+ ,gistUrl :: !Text
+ ,gistDescription :: !(Maybe Text)
+ ,gistCreatedAt :: !UTCTime
+ ,gistPublic :: !Bool
+ ,gistComments :: !Int
+ ,gistUpdatedAt :: !UTCTime
+ ,gistHtmlUrl :: !Text
+ ,gistId :: !(Name Gist)
+ ,gistFiles :: !(HashMap Text GistFile)
+ ,gistGitPullUrl :: !Text
+} deriving (Show, Data, Typeable, Eq, Generic)
+
+instance NFData Gist where rnf = genericRnf
+instance Binary Gist
+
+instance FromJSON Gist where
+ parseJSON = withObject "Gist" $ \o ->
+ Gist <$> o .: "owner"
+ <*> o .: "git_push_url"
+ <*> o .: "url"
+ <*> o .:? "description"
+ <*> o .: "created_at"
+ <*> o .: "public"
+ <*> o .: "comments"
+ <*> o .: "updated_at"
+ <*> o .: "html_url"
+ <*> o .: "id"
+ <*> o .: "files"
+ <*> o .: "git_push_url"
+
+data GistFile = GistFile {
+ gistFileType :: !Text
+ ,gistFileRawUrl :: !Text
+ ,gistFileSize :: !Int
+ ,gistFileLanguage :: !(Maybe Language)
+ ,gistFileFilename :: !Text
+ ,gistFileContent :: !(Maybe Text)
+} deriving (Show, Data, Typeable, Eq, Generic)
+
+instance NFData GistFile where rnf = genericRnf
+instance Binary GistFile
+
+instance FromJSON GistFile where
+ parseJSON = withObject "GistFile" $ \o ->
+ GistFile <$> o .: "type"
+ <*> o .: "raw_url"
+ <*> o .: "size"
+ <*> o .:? "language"
+ <*> o .: "filename"
+ <*> o .:? "content"
+
+data GistComment = GistComment {
+ gistCommentUser :: !SimpleUser
+ ,gistCommentUrl :: !Text
+ ,gistCommentCreatedAt :: !UTCTime
+ ,gistCommentBody :: !Text
+ ,gistCommentUpdatedAt :: !UTCTime
+ ,gistCommentId :: !(Id GistComment)
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData GistComment where rnf = genericRnf
+instance Binary GistComment
+
+instance FromJSON GistComment where
+ parseJSON = withObject "GistComment" $ \o ->
+ GistComment <$> o .: "user"
+ <*> o .: "url"
+ <*> o .: "created_at"
+ <*> o .: "body"
+ <*> o .: "updated_at"
+ <*> o .: "id"
diff --git a/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Data/GitData.hs
@@ -0,0 +1,313 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+module GitHub.Data.GitData where
+
+import Prelude ()
+import Prelude.Compat
+
+import GitHub.Data.Definitions
+import GitHub.Data.Name (Name)
+
+import Control.DeepSeq (NFData (..))
+import Control.DeepSeq.Generics (genericRnf)
+import Data.Aeson.Compat (FromJSON (..), ToJSON (..), object, withObject,
+ (.!=), (.:), (.:?), (.=))
+import Data.Binary (Binary)
+import Data.Data (Data, Typeable)
+import Data.Text (Text)
+import Data.Time (UTCTime)
+import Data.Vector (Vector)
+import GHC.Generics (Generic)
+
+import qualified Data.Vector as V
+
+-- | The options for querying commits.
+data CommitQueryOption = CommitQuerySha !Text
+ | CommitQueryPath !Text
+ | CommitQueryAuthor !Text
+ | CommitQuerySince !UTCTime
+ | CommitQueryUntil !UTCTime
+ deriving (Show, Eq, Ord, Generic, Typeable, Data)
+
+data Stats = Stats {
+ statsAdditions :: !Int
+ ,statsTotal :: !Int
+ ,statsDeletions :: !Int
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData Stats where rnf = genericRnf
+instance Binary Stats
+
+data Commit = Commit {
+ commitSha :: !(Name Commit)
+ ,commitParents :: !(Vector Tree)
+ ,commitUrl :: !Text
+ ,commitGitCommit :: !GitCommit
+ ,commitCommitter :: !(Maybe SimpleUser)
+ ,commitAuthor :: !(Maybe SimpleUser)
+ ,commitFiles :: !(Vector File)
+ ,commitStats :: !(Maybe Stats)
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData Commit where rnf = genericRnf
+instance Binary Commit
+
+data Tree = Tree {
+ treeSha :: !(Name Tree)
+ ,treeUrl :: !Text
+ ,treeGitTrees :: !(Vector GitTree)
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData Tree where rnf = genericRnf
+instance Binary Tree
+
+data GitTree = GitTree {
+ gitTreeType :: !Text
+ ,gitTreeSha :: !(Name GitTree)
+ -- Can be empty for submodule
+ ,gitTreeUrl :: !(Maybe Text)
+ ,gitTreeSize :: !(Maybe Int)
+ ,gitTreePath :: !Text
+ ,gitTreeMode :: !Text
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData GitTree where rnf = genericRnf
+instance Binary GitTree
+
+data GitCommit = GitCommit {
+ gitCommitMessage :: !Text
+ ,gitCommitUrl :: !Text
+ ,gitCommitCommitter :: !GitUser
+ ,gitCommitAuthor :: !GitUser
+ ,gitCommitTree :: !Tree
+ ,gitCommitSha :: !(Maybe (Name GitCommit))
+ ,gitCommitParents :: !(Vector Tree)
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData GitCommit where rnf = genericRnf
+instance Binary GitCommit
+
+data Blob = Blob {
+ blobUrl :: !Text
+ ,blobEncoding :: !Text
+ ,blobContent :: !Text
+ ,blobSha :: !(Name Blob)
+ ,blobSize :: !Int
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData Blob where rnf = genericRnf
+instance Binary Blob
+
+data Tag = Tag {
+ tagName :: !Text
+ ,tagZipballUrl :: !Text
+ ,tagTarballUrl :: !Text
+ ,tagCommit :: !BranchCommit
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData Tag where rnf = genericRnf
+instance Binary Tag
+
+data Branch = Branch {
+ branchName :: !Text
+ ,branchCommit :: !BranchCommit
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData Branch where rnf = genericRnf
+
+data BranchCommit = BranchCommit {
+ branchCommitSha :: !Text
+ ,branchCommitUrl :: !Text
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData BranchCommit where rnf = genericRnf
+instance Binary BranchCommit
+
+data Diff = Diff {
+ diffStatus :: !Text
+ ,diffBehindBy :: !Int
+ ,diffPatchUrl :: !Text
+ ,diffUrl :: !Text
+ ,diffBaseCommit :: !Commit
+ ,diffCommits :: !(Vector Commit)
+ ,diffTotalCommits :: !Int
+ ,diffHtmlUrl :: !Text
+ ,diffFiles :: !(Vector File)
+ ,diffAheadBy :: !Int
+ ,diffDiffUrl :: !Text
+ ,diffPermalinkUrl :: !Text
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData Diff where rnf = genericRnf
+instance Binary Diff
+
+data NewGitReference = NewGitReference {
+ newGitReferenceRef :: !Text
+ ,newGitReferenceSha :: !Text
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData NewGitReference where rnf = genericRnf
+instance Binary NewGitReference
+
+data GitReference = GitReference {
+ gitReferenceObject :: !GitObject
+ ,gitReferenceUrl :: !Text
+ ,gitReferenceRef :: !Text
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData GitReference where rnf = genericRnf
+instance Binary GitReference
+
+data GitObject = GitObject {
+ gitObjectType :: !Text
+ ,gitObjectSha :: !Text
+ ,gitObjectUrl :: !Text
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData GitObject where rnf = genericRnf
+instance Binary GitObject
+
+data GitUser = GitUser {
+ gitUserName :: !Text
+ ,gitUserEmail :: !Text
+ ,gitUserDate :: !UTCTime
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData GitUser where rnf = genericRnf
+instance Binary GitUser
+
+data File = File {
+ fileBlobUrl :: !Text
+ ,fileStatus :: !Text
+ ,fileRawUrl :: !Text
+ ,fileAdditions :: !Int
+ ,fileSha :: !Text
+ ,fileChanges :: !Int
+ ,filePatch :: !(Maybe Text)
+ ,fileFilename :: !Text
+ ,fileDeletions :: !Int
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData File where rnf = genericRnf
+instance Binary File
+
+-- JSON instances
+
+instance FromJSON Stats where
+ parseJSON = withObject "Stats" $ \o ->
+ Stats <$> o .: "additions"
+ <*> o .: "total"
+ <*> o .: "deletions"
+
+instance FromJSON Commit where
+ parseJSON = withObject "Commit" $ \o ->
+ Commit <$> o .: "sha"
+ <*> o .: "parents"
+ <*> o .: "url"
+ <*> o .: "commit"
+ <*> o .:? "committer"
+ <*> o .:? "author"
+ <*> o .:? "files" .!= V.empty
+ <*> o .:? "stats"
+
+instance FromJSON Tree where
+ parseJSON = withObject "Tree" $ \o ->
+ Tree <$> o .: "sha"
+ <*> o .: "url"
+ <*> o .:? "tree" .!= V.empty
+
+instance FromJSON GitTree where
+ parseJSON = withObject "GitTree" $ \o ->
+ GitTree <$> o .: "type"
+ <*> o .: "sha"
+ <*> o .:? "url"
+ <*> o .:? "size"
+ <*> o .: "path"
+ <*> o .: "mode"
+
+instance FromJSON GitCommit where
+ parseJSON = withObject "GitCommit" $ \o ->
+ GitCommit <$> o .: "message"
+ <*> o .: "url"
+ <*> o .: "committer"
+ <*> o .: "author"
+ <*> o .: "tree"
+ <*> o .:? "sha"
+ <*> o .:? "parents" .!= V.empty
+
+instance FromJSON GitUser where
+ parseJSON = withObject "GitUser" $ \o ->
+ GitUser <$> o .: "name"
+ <*> o .: "email"
+ <*> o .: "date"
+
+instance FromJSON File where
+ parseJSON = withObject "File" $ \o ->
+ File <$> o .: "blob_url"
+ <*> o .: "status"
+ <*> o .: "raw_url"
+ <*> o .: "additions"
+ <*> o .: "sha"
+ <*> o .: "changes"
+ <*> o .:? "patch"
+ <*> o .: "filename"
+ <*> o .: "deletions"
+
+instance ToJSON NewGitReference where
+ toJSON (NewGitReference r s) = object [ "ref" .= r, "sha" .= s ]
+
+instance FromJSON GitReference where
+ parseJSON = withObject "GitReference" $ \o ->
+ GitReference <$> o .: "object"
+ <*> o .: "url"
+ <*> o .: "ref"
+
+instance FromJSON GitObject where
+ parseJSON = withObject "GitObject" $ \o ->
+ GitObject <$> o .: "type"
+ <*> o .: "sha"
+ <*> o .: "url"
+
+instance FromJSON Diff where
+ parseJSON = withObject "Diff" $ \o ->
+ Diff <$> o .: "status"
+ <*> o .: "behind_by"
+ <*> o .: "patch_url"
+ <*> o .: "url"
+ <*> o .: "base_commit"
+ <*> o .:? "commits" .!= V.empty
+ <*> o .: "total_commits"
+ <*> o .: "html_url"
+ <*> o .:? "files" .!= V.empty
+ <*> o .: "ahead_by"
+ <*> o .: "diff_url"
+ <*> o .: "permalink_url"
+
+instance FromJSON Blob where
+ parseJSON = withObject "Blob" $ \o ->
+ Blob <$> o .: "url"
+ <*> o .: "encoding"
+ <*> o .: "content"
+ <*> o .: "sha"
+ <*> o .: "size"
+
+instance FromJSON Tag where
+ parseJSON = withObject "Tag" $ \o ->
+ Tag <$> o .: "name"
+ <*> o .: "zipball_url"
+ <*> o .: "tarball_url"
+ <*> o .: "commit"
+
+instance FromJSON Branch where
+ parseJSON = withObject "Branch" $ \o ->
+ Branch <$> o .: "name" <*> o .: "commit"
+
+instance FromJSON BranchCommit where
+ parseJSON = withObject "BranchCommit" $ \o ->
+ BranchCommit <$> o .: "sha" <*> o .: "url"
diff --git a/src/GitHub/Data/Id.hs b/src/GitHub/Data/Id.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Data/Id.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+module GitHub.Data.Id (
+ Id(..),
+ mkId,
+ untagId,
+ ) where
+
+import Control.DeepSeq (NFData (..))
+import Data.Aeson.Compat (FromJSON (..), ToJSON (..))
+import Data.Binary (Binary)
+import Data.Data (Data, Typeable)
+import Data.Hashable (Hashable)
+import GHC.Generics (Generic)
+
+-- | Numeric identifier.
+newtype Id entity = Id Int
+ deriving (Eq, Ord, Show, Generic, Typeable, Data)
+
+-- | Smart constructor for 'Id'.
+mkId :: proxy entity -> Int -> Id entity
+mkId _ = Id
+
+untagId :: Id entity -> Int
+untagId (Id name) = name
+
+instance Hashable (Id entity)
+instance Binary (Id entity)
+
+instance NFData (Id entity) where
+ rnf (Id s) = rnf s
+
+instance FromJSON (Id entity) where
+ parseJSON = fmap Id . parseJSON
+
+instance ToJSON (Id entity) where
+ toJSON = toJSON . untagId
diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Data/Issues.hs
@@ -0,0 +1,275 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+module GitHub.Data.Issues where
+
+import Prelude ()
+import Prelude.Compat
+
+import GitHub.Data.Definitions
+import GitHub.Data.Id (Id)
+import GitHub.Data.PullRequests
+
+import Control.DeepSeq (NFData (..))
+import Control.DeepSeq.Generics (genericRnf)
+import Data.Aeson.Compat (FromJSON (..), ToJSON (..), Value (..), object,
+ withObject, (.:), (.:?), (.=))
+import Data.Binary (Binary)
+import Data.Data (Data, Typeable)
+import Data.Text (Text)
+import Data.Time (UTCTime)
+import Data.Vector (Vector)
+import GHC.Generics (Generic)
+
+data Issue = Issue {
+ issueClosedAt :: Maybe UTCTime
+ ,issueUpdatedAt :: UTCTime
+ ,issueEventsUrl :: Text
+ ,issueHtmlUrl :: Maybe Text
+ ,issueClosedBy :: Maybe SimpleUser
+ ,issueLabels :: (Vector IssueLabel)
+ ,issueNumber :: Int
+ ,issueAssignee :: Maybe SimpleUser
+ ,issueUser :: SimpleUser
+ ,issueTitle :: Text
+ ,issuePullRequest :: Maybe PullRequestReference
+ ,issueUrl :: Text
+ ,issueCreatedAt :: UTCTime
+ ,issueBody :: Maybe Text
+ ,issueState :: Text
+ ,issueId :: Id Issue
+ ,issueComments :: Int
+ ,issueMilestone :: Maybe Milestone
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData Issue where rnf = genericRnf
+instance Binary Issue
+
+data NewIssue = NewIssue {
+ newIssueTitle :: Text
+, newIssueBody :: Maybe Text
+, newIssueAssignee :: Maybe Text
+, newIssueMilestone :: Maybe Int
+, newIssueLabels :: Maybe (Vector Text)
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData NewIssue where rnf = genericRnf
+instance Binary NewIssue
+
+data EditIssue = EditIssue {
+ editIssueTitle :: Maybe Text
+, editIssueBody :: Maybe Text
+, editIssueAssignee :: Maybe Text
+, editIssueState :: Maybe Text
+, editIssueMilestone :: Maybe Int
+, editIssueLabels :: Maybe (Vector Text)
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData EditIssue where rnf = genericRnf
+instance Binary EditIssue
+
+data Milestone = Milestone {
+ milestoneCreator :: SimpleUser
+ ,milestoneDueOn :: Maybe UTCTime
+ ,milestoneOpenIssues :: Int
+ ,milestoneNumber :: Int
+ ,milestoneClosedIssues :: Int
+ ,milestoneDescription :: Maybe Text
+ ,milestoneTitle :: Text
+ ,milestoneUrl :: Text
+ ,milestoneCreatedAt :: UTCTime
+ ,milestoneState :: Text
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData Milestone where rnf = genericRnf
+instance Binary Milestone
+
+data IssueLabel = IssueLabel {
+ labelColor :: Text
+ ,labelUrl :: Text
+ ,labelName :: Text
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData IssueLabel where rnf = genericRnf
+instance Binary IssueLabel
+
+data IssueComment = IssueComment {
+ issueCommentUpdatedAt :: UTCTime
+ ,issueCommentUser :: SimpleUser
+ ,issueCommentUrl :: Text
+ ,issueCommentHtmlUrl :: Text
+ ,issueCommentCreatedAt :: UTCTime
+ ,issueCommentBody :: Text
+ ,issueCommentId :: Int
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData IssueComment where rnf = genericRnf
+instance Binary IssueComment
+
+data EventType =
+ Mentioned -- ^ The actor was @mentioned in an issue body.
+ | Subscribed -- ^ The actor subscribed to receive notifications for an issue.
+ | Unsubscribed -- ^ The issue was unsubscribed from by the actor.
+ | Referenced -- ^ The issue was referenced from a commit message. The commit_id attribute is the commit SHA1 of where that happened.
+ | Merged -- ^ The issue was merged by the actor. The commit_id attribute is the SHA1 of the HEAD commit that was merged.
+ | Assigned -- ^ The issue was assigned to the actor.
+ | Closed -- ^ The issue was closed by the actor. When the commit_id is present, it identifies the commit that closed the issue using “closes / fixes #NN” syntax.
+ | Reopened -- ^ The issue was reopened by the actor.
+ | ActorUnassigned -- ^ The issue was unassigned to the actor
+ | Labeled -- ^ A label was added to the issue.
+ | Unlabeled -- ^ A label was removed from the issue.
+ | Milestoned -- ^ The issue was added to a milestone.
+ | Demilestoned -- ^ The issue was removed from a milestone.
+ | Renamed -- ^ The issue title was changed.
+ | Locked -- ^ The issue was locked by the actor.
+ | Unlocked -- ^ The issue was unlocked by the actor.
+ | HeadRefDeleted -- ^ The pull request’s branch was deleted.
+ | HeadRefRestored -- ^ The pull request’s branch was restored.
+ deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData EventType where rnf = genericRnf
+instance Binary EventType
+
+-- | Issue event
+data Event = Event {
+ eventActor :: !SimpleUser
+ ,eventType :: !EventType
+ ,eventCommitId :: !(Maybe Text)
+ ,eventUrl :: !Text
+ ,eventCreatedAt :: !UTCTime
+ ,eventId :: !Int
+ ,eventIssue :: !(Maybe Issue)
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData Event where rnf = genericRnf
+instance Binary Event
+
+-- | A data structure for describing how to filter issues. This is used by
+-- @issuesForRepo@.
+data IssueLimitation =
+ AnyMilestone -- ^ Issues appearing in any milestone. [default]
+ | NoMilestone -- ^ Issues without a milestone.
+ | MilestoneId Int -- ^ Only issues that are in the milestone with the given id.
+ | Open -- ^ Only open issues. [default]
+ | OnlyClosed -- ^ Only closed issues.
+ | Unassigned -- ^ Issues to which no one has been assigned ownership.
+ | AnyAssignment -- ^ All issues regardless of assignment. [default]
+ | AssignedTo String -- ^ Only issues assigned to the user with the given login.
+ | Mentions String -- ^ Issues which mention the given string, taken to be a user's login.
+ | Labels [String] -- ^ A list of labels to filter by.
+ | Ascending -- ^ Sort ascending.
+ | Descending -- ^ Sort descending. [default]
+ | Since UTCTime -- ^ Only issues created since the specified date and time.
+ | PerPage Int -- ^ Download this many issues per query
+ deriving (Eq, Ord, Show, Typeable, Data, Generic)
+
+instance NFData IssueLimitation where rnf = genericRnf
+instance Binary IssueLimitation
+
+-- JSON instances
+
+instance FromJSON Event where
+ parseJSON = withObject "Event" $ \o ->
+ Event <$> o .: "actor"
+ <*> o .: "event"
+ <*> o .:? "commit_id"
+ <*> o .: "url"
+ <*> o .: "created_at"
+ <*> o .: "id"
+ <*> o .:? "issue"
+
+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 IssueLabel where
+ parseJSON = withObject "IssueLabel" $ \o ->
+ IssueLabel <$> o .: "color"
+ <*> o .: "url"
+ <*> o .: "name"
+
+instance FromJSON IssueComment where
+ parseJSON = withObject "IssueComment" $ \o ->
+ IssueComment <$> o .: "updated_at"
+ <*> o .: "user"
+ <*> o .: "url"
+ <*> o .: "html_url"
+ <*> o .: "created_at"
+ <*> o .: "body"
+ <*> o .: "id"
+
+instance FromJSON Issue where
+ parseJSON = withObject "Issue" $ \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"
+
+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 = withObject "Milestone" $ \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"
diff --git a/src/GitHub/Data/Name.hs b/src/GitHub/Data/Name.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Data/Name.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+module GitHub.Data.Name (
+ Name(..),
+ mkName,
+ untagName,
+ ) where
+
+import Control.DeepSeq (NFData (..))
+import Data.Aeson.Compat (FromJSON (..), ToJSON (..))
+import Data.Binary.Orphans (Binary)
+import Data.Data (Data, Typeable)
+import Data.Hashable (Hashable)
+import Data.String (IsString (..))
+import Data.Text (Text)
+import GHC.Generics (Generic)
+
+newtype Name entity = N Text
+ deriving (Eq, Ord, Show, Generic, Typeable, Data)
+
+-- | Smart constructor for 'Name'
+mkName :: proxy entity -> Text -> Name entity
+mkName _ = N
+
+untagName :: Name entity -> Text
+untagName (N name) = name
+
+instance Hashable (Name entity)
+instance Binary (Name entity)
+
+instance NFData (Name entity) where
+ rnf (N s) = rnf s
+
+instance FromJSON (Name entity) where
+ parseJSON = fmap N . parseJSON
+
+instance ToJSON (Name entity) where
+ toJSON = toJSON . untagName
+
+instance IsString (Name entity) where
+ fromString = N . fromString
diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Data/PullRequests.hs
@@ -0,0 +1,291 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+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 {
+ -- this is a duplication of a 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
+
+-- JSON instances
+
+
+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"
+
+-- Helpers
+
+-- | Produce the value for the last key by traversing.
+(<.:>) :: 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"
diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Data/Repos.hs
@@ -0,0 +1,266 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+#define UNSAFE 1
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- This module also exports
+-- @'FromJSON' a => 'FromJSON' ('HM.HashMap' 'Language' a)@
+-- orphan-ish instance.
+module GitHub.Data.Repos where
+
+import Prelude ()
+import Prelude.Compat
+
+import GitHub.Data.Definitions
+import GitHub.Data.Id (Id)
+import GitHub.Data.Name (Name)
+
+--import Control.Arrow (first) -- Data.Bifunctor would be better
+import Control.DeepSeq (NFData (..))
+import Control.DeepSeq.Generics (genericRnf)
+import Data.Aeson.Compat (FromJSON (..), ToJSON (..), object, withObject,
+ withText, (.:), (.:?), (.=))
+import Data.Binary (Binary)
+import Data.Data (Data, Typeable)
+import Data.Hashable (Hashable (..))
+import Data.String (IsString (..))
+import Data.Text (Text)
+import Data.Time (UTCTime)
+import GHC.Generics (Generic)
+
+import qualified Data.HashMap.Strict as HM
+
+#if UNSAFE
+import Unsafe.Coerce (unsafeCoerce)
+#endif
+
+data Repo = Repo {
+ repoSshUrl :: !(Maybe Text)
+ ,repoDescription :: !(Maybe Text)
+ ,repoCreatedAt :: !(Maybe UTCTime)
+ ,repoHtmlUrl :: !Text
+ ,repoSvnUrl :: !(Maybe Text)
+ ,repoForks :: !(Maybe Int)
+ ,repoHomepage :: !(Maybe Text)
+ ,repoFork :: !(Maybe Bool)
+ ,repoGitUrl :: !(Maybe Text)
+ ,repoPrivate :: !Bool
+ ,repoCloneUrl :: !(Maybe Text)
+ ,repoSize :: !(Maybe Int)
+ ,repoUpdatedAt :: !(Maybe UTCTime)
+ ,repoWatchers :: !(Maybe Int)
+ ,repoOwner :: !SimpleOwner
+ ,repoName :: !(Name Repo)
+ ,repoLanguage :: !(Maybe Language)
+ ,repoMasterBranch :: !(Maybe Text)
+ ,repoPushedAt :: !(Maybe UTCTime) -- ^ this is Nothing for new repositories
+ ,repoId :: !(Id Repo)
+ ,repoUrl :: !Text
+ ,repoOpenIssues :: !(Maybe Int)
+ ,repoHasWiki :: !(Maybe Bool)
+ ,repoHasIssues :: !(Maybe Bool)
+ ,repoHasDownloads :: !(Maybe Bool)
+ ,repoParent :: !(Maybe RepoRef)
+ ,repoSource :: !(Maybe RepoRef)
+ ,repoHooksUrl :: !Text
+ ,repoStargazersCount :: !Int
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData Repo where rnf = genericRnf
+instance Binary Repo
+
+data RepoRef = RepoRef
+ { repoRefOwner :: !SimpleOwner
+ , repoRefRepo :: !(Name Repo)
+ }
+ deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData RepoRef where rnf = genericRnf
+instance Binary RepoRef
+
+data NewRepo = NewRepo {
+ newRepoName :: !(Name Repo)
+, newRepoDescription :: !(Maybe Text)
+, newRepoHomepage :: !(Maybe Text)
+, newRepoPrivate :: !(Maybe Bool)
+, newRepoHasIssues :: !(Maybe Bool)
+, newRepoHasWiki :: !(Maybe Bool)
+, newRepoAutoInit :: !(Maybe Bool)
+} deriving (Eq, Ord, Show, Data, Typeable, Generic)
+
+instance NFData NewRepo where rnf = genericRnf
+instance Binary NewRepo
+
+newRepo :: Name Repo -> NewRepo
+newRepo name = NewRepo name Nothing Nothing Nothing Nothing Nothing Nothing
+
+data EditRepo = EditRepo {
+ editName :: !(Maybe (Name Repo))
+, editDescription :: !(Maybe Text)
+, editHomepage :: !(Maybe Text)
+, editPublic :: !(Maybe Bool)
+, editHasIssues :: !(Maybe Bool)
+, editHasWiki :: !(Maybe Bool)
+, editHasDownloads :: !(Maybe Bool)
+} deriving (Eq, Ord, Show, Data, Typeable, Generic)
+
+instance NFData EditRepo where rnf = genericRnf
+instance Binary EditRepo
+
+-- | Filter the list of the user's repos using any of these constructors.
+data RepoPublicity
+ = RepoPublicityAll -- ^ All repos accessible to the user.
+ | RepoPublicityOwner -- ^ Only repos owned by the user.
+ | RepoPublicityPublic -- ^ Only public repos.
+ | RepoPublicityPrivate -- ^ Only private repos.
+ | RepoPublicityMember -- ^ Only repos to which the user is a member but not an owner.
+ deriving (Show, Eq, Ord, Typeable, Data, Generic)
+
+-- | The value is the number of bytes of code written in that language.
+type Languages = HM.HashMap Language Int
+
+-- | A programming language.
+newtype Language = Language Text
+ deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+getLanguage :: Language -> Text
+getLanguage (Language l) = l
+
+instance NFData Language where rnf = genericRnf
+instance Binary Language
+instance Hashable Language where
+ hashWithSalt salt (Language l) = hashWithSalt salt l
+instance IsString Language where
+ fromString = Language . fromString
+
+data Contributor
+ -- | An existing Github user, with their number of contributions, avatar
+ -- URL, login, URL, ID, and Gravatar ID.
+ = KnownContributor !Int !Text !(Name User) !Text !(Id User) !Text
+ -- | An unknown Github user with their number of contributions and recorded name.
+ | AnonymousContributor !Int !Text
+ deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData Contributor where rnf = genericRnf
+instance Binary Contributor
+
+contributorToSimpleUser :: Contributor -> Maybe SimpleUser
+contributorToSimpleUser (AnonymousContributor _ _) = Nothing
+contributorToSimpleUser (KnownContributor _contributions avatarUrl name url uid _gravatarid) =
+ Just $ SimpleUser uid name avatarUrl url OwnerUser
+
+-- JSON instances
+
+instance FromJSON Repo where
+ parseJSON = withObject "Repo" $ \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"
+ <*> o .: "stargazers_count"
+
+instance ToJSON NewRepo where
+ toJSON (NewRepo { newRepoName = name
+ , newRepoDescription = description
+ , newRepoHomepage = homepage
+ , newRepoPrivate = private
+ , newRepoHasIssues = hasIssues
+ , newRepoHasWiki = hasWiki
+ , newRepoAutoInit = autoInit
+ }) = object
+ [ "name" .= name
+ , "description" .= description
+ , "homepage" .= homepage
+ , "private" .= private
+ , "has_issues" .= hasIssues
+ , "has_wiki" .= hasWiki
+ , "auto_init" .= autoInit
+ ]
+
+instance ToJSON EditRepo where
+ toJSON (EditRepo { editName = name
+ , editDescription = description
+ , editHomepage = homepage
+ , editPublic = public
+ , editHasIssues = hasIssues
+ , editHasWiki = hasWiki
+ , editHasDownloads = hasDownloads
+ }) = object
+ [ "name" .= name
+ , "description" .= description
+ , "homepage" .= homepage
+ , "public" .= public
+ , "has_issues" .= hasIssues
+ , "has_wiki" .= hasWiki
+ , "has_downloads" .= hasDownloads
+ ]
+
+instance FromJSON RepoRef where
+ parseJSON = withObject "RepoRef" $ \o ->
+ RepoRef <$> o .: "owner"
+ <*> o .: "name"
+
+instance FromJSON Contributor where
+ parseJSON = withObject "Contributor" $ \o -> do
+ t <- o .: "type"
+ case t of
+ _ | t == ("Anonymous" :: Text) ->
+ AnonymousContributor
+ <$> o .: "contributions"
+ <*> o .: "name"
+ _ | otherwise ->
+ KnownContributor
+ <$> o .: "contributions"
+ <*> o .: "avatar_url"
+ <*> o .: "login"
+ <*> o .: "url"
+ <*> o .: "id"
+ <*> o .: "gravatar_id"
+
+instance FromJSON Language where
+ parseJSON = withText "Language" (pure . Language)
+
+instance ToJSON Language where
+ toJSON = toJSON . getLanguage
+
+instance FromJSON a => FromJSON (HM.HashMap Language a) where
+ parseJSON = fmap mapKeyLanguage . parseJSON
+ where
+ mapKeyLanguage :: HM.HashMap Text a -> HM.HashMap Language a
+#ifdef UNSAFE
+ mapKeyLanguage = unsafeCoerce
+#else
+ mapKeyLanguage = mapKey Language
+ mapKey :: (Eq k2, Hashable k2) => (k1 -> k2) -> HM.HashMap k1 a -> HM.HashMap k2 a
+ mapKey f = HM.fromList . map (first f) . HM.toList
+#endif
diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Data/Request.hs
@@ -0,0 +1,176 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StandaloneDeriving #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+module GitHub.Data.Request (
+ Request(..),
+ CommandMethod(..),
+ toMethod,
+ StatusMap(..),
+ MergeResult(..),
+ Paths,
+ IsPathPart(..),
+ QueryString,
+ Count,
+ ) where
+
+import Data.Aeson.Compat (FromJSON)
+import Data.Hashable (Hashable (..))
+import Data.Typeable (Typeable)
+import Data.Vector (Vector)
+import GHC.Generics (Generic)
+
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.Text as T
+import qualified Network.HTTP.Types.Method as Method
+
+import GitHub.Data.Id (Id, untagId)
+import GitHub.Data.Name (Name, untagName)
+
+------------------------------------------------------------------------------
+-- Auxillary types
+------------------------------------------------------------------------------
+
+type Paths = [String]
+type QueryString = [(BS.ByteString, Maybe BS.ByteString)]
+type Count = Int
+
+class IsPathPart a where
+ toPathPart :: a -> String
+
+instance IsPathPart (Name a) where
+ toPathPart = T.unpack . untagName
+
+instance IsPathPart (Id a) where
+ toPathPart = show . untagId
+
+-- | Http method of requests with body.
+data CommandMethod a where
+ Post :: CommandMethod a
+ Patch :: CommandMethod a
+ Put :: CommandMethod a
+ Delete :: CommandMethod ()
+ deriving (Typeable)
+
+deriving instance Eq (CommandMethod a)
+
+instance Show (CommandMethod a) where
+ showsPrec _ Post = showString "Post"
+ showsPrec _ Patch = showString "Patch"
+ showsPrec _ Put = showString "Put"
+ showsPrec _ Delete = showString "Delete"
+
+instance Hashable (CommandMethod a) where
+ hashWithSalt salt Post = hashWithSalt salt (0 :: Int)
+ hashWithSalt salt Patch = hashWithSalt salt (1 :: Int)
+ hashWithSalt salt Put = hashWithSalt salt (2 :: Int)
+ hashWithSalt salt Delete = hashWithSalt salt (3 :: Int)
+
+toMethod :: CommandMethod a -> Method.Method
+toMethod Post = Method.methodPost
+toMethod Patch = Method.methodPatch
+toMethod Put = Method.methodPut
+toMethod Delete = Method.methodDelete
+
+-- | Result of merge operation
+data MergeResult = MergeSuccessful
+ | MergeCannotPerform
+ | MergeConflict
+ deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
+
+instance Hashable MergeResult
+
+-- | Status code transform
+data StatusMap a where
+ StatusOnlyOk :: StatusMap Bool
+ StatusMerge :: StatusMap MergeResult
+ deriving (Typeable)
+
+deriving instance Eq (StatusMap a)
+
+instance Show (StatusMap a) where
+ showsPrec _ StatusOnlyOk = showString "StatusOnlyOK"
+ showsPrec _ StatusMerge = showString "StatusMerge"
+
+instance Hashable (StatusMap a) where
+ hashWithSalt salt StatusOnlyOk = hashWithSalt salt (0 :: Int)
+ hashWithSalt salt StatusMerge = hashWithSalt salt (1 :: Int)
+
+------------------------------------------------------------------------------
+-- Github request
+------------------------------------------------------------------------------
+
+-- | Github request data type.
+--
+-- * @k@ describes whether authentication is required. It's required for non-@GET@ requests.
+-- * @a@ is the result type
+--
+-- /Note:/ 'Request' is not 'Functor' on purpose.
+data Request (k :: Bool) a where
+ Query :: FromJSON a => Paths -> QueryString -> Request k a
+ PagedQuery :: FromJSON (Vector a) => Paths -> QueryString -> Maybe Count -> Request k (Vector a)
+ Command :: FromJSON a => CommandMethod a -> Paths -> LBS.ByteString -> Request 'True a
+ StatusQuery :: StatusMap a -> Request k () -> Request k a
+ deriving (Typeable)
+
+deriving instance Eq (Request k a)
+
+instance Show (Request k a) where
+ showsPrec d r =
+ case r of
+ Query ps qs -> showParen (d > appPrec) $
+ showString "Query "
+ . showsPrec (appPrec + 1) ps
+ . showString " "
+ . showsPrec (appPrec + 1) qs
+ PagedQuery ps qs l -> showParen (d > appPrec) $
+ showString "PagedQuery "
+ . showsPrec (appPrec + 1) ps
+ . showString " "
+ . showsPrec (appPrec + 1) qs
+ . showString " "
+ . showsPrec (appPrec + 1) l
+ Command m ps body -> showParen (d > appPrec) $
+ showString "Command "
+ . showsPrec (appPrec + 1) m
+ . showString " "
+ . showsPrec (appPrec + 1) ps
+ . showString " "
+ . showsPrec (appPrec + 1) body
+ StatusQuery m req -> showParen (d > appPrec) $
+ showString "Status "
+ . showsPrec (appPrec + 1) m
+ . showString " "
+ . showsPrec (appPrec + 1) req
+ where appPrec = 10 :: Int
+
+instance Hashable (Request k a) where
+ hashWithSalt salt (Query ps qs) =
+ salt `hashWithSalt` (0 :: Int)
+ `hashWithSalt` ps
+ `hashWithSalt` qs
+ hashWithSalt salt (PagedQuery ps qs l) =
+ salt `hashWithSalt` (1 :: Int)
+ `hashWithSalt` ps
+ `hashWithSalt` qs
+ `hashWithSalt` l
+ hashWithSalt salt (Command m ps body) =
+ salt `hashWithSalt` (2 :: Int)
+ `hashWithSalt` m
+ `hashWithSalt` ps
+ `hashWithSalt` body
+ hashWithSalt salt (StatusQuery sm req) =
+ salt `hashWithSalt` (3 :: Int)
+ `hashWithSalt` sm
+ `hashWithSalt` req
diff --git a/src/GitHub/Data/Search.hs b/src/GitHub/Data/Search.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Data/Search.hs
@@ -0,0 +1,61 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+module GitHub.Data.Search where
+
+import Prelude ()
+import Prelude.Compat
+
+import GitHub.Data.Repos (Repo)
+
+import Control.DeepSeq (NFData (..))
+import Control.DeepSeq.Generics (genericRnf)
+import Data.Aeson.Compat (FromJSON (..), withObject, (.!=), (.:), (.:?))
+import Data.Binary (Binary)
+import Data.Data (Data, Typeable)
+import Data.Text (Text)
+import Data.Vector (Vector)
+import GHC.Generics (Generic)
+
+import qualified Data.Vector as V
+
+data SearchResult entity = SearchResult {
+ searchResultTotalCount :: !Int
+ ,searchResultResults :: !(Vector entity)
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData entity => NFData (SearchResult entity) where rnf = genericRnf
+instance Binary entity => Binary (SearchResult entity)
+
+instance FromJSON entity => FromJSON (SearchResult entity) where
+ parseJSON = withObject "SearchResult" $ \o ->
+ SearchResult <$> o .: "total_count"
+ <*> o .:? "items" .!= V.empty
+
+data Code = Code {
+ codeName :: !Text
+ ,codePath :: !Text
+ ,codeSha :: !Text
+ ,codeUrl :: !Text
+ ,codeGitUrl :: !Text
+ ,codeHtmlUrl :: !Text
+ ,codeRepo :: !Repo
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData Code where rnf = genericRnf
+instance Binary Code
+
+instance FromJSON Code where
+ parseJSON = withObject "Code" $ \o ->
+ Code <$> o .: "name"
+ <*> o .: "path"
+ <*> o .: "sha"
+ <*> o .: "url"
+ <*> o .: "git_url"
+ <*> o .: "html_url"
+ <*> o .: "repository"
diff --git a/src/GitHub/Data/Teams.hs b/src/GitHub/Data/Teams.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Data/Teams.hs
@@ -0,0 +1,245 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+module GitHub.Data.Teams where
+
+import Prelude ()
+import Prelude.Compat
+
+import GitHub.Data.Definitions
+
+import Control.DeepSeq (NFData (..))
+import Control.DeepSeq.Generics (genericRnf)
+import Data.Aeson.Compat (FromJSON (..), ToJSON (..), Value (..), object,
+ withObject, (.!=), (.:), (.:?), (.=))
+import Data.Binary (Binary)
+import Data.Data (Data, Typeable)
+import Data.Text (Text)
+import Data.Vector (Vector)
+import GHC.Generics (Generic)
+
+import GitHub.Data.Id (Id)
+import GitHub.Data.Name (Name)
+import GitHub.Data.Repos (Repo)
+
+data Privacy =
+ PrivacyClosed
+ | PrivacySecret
+ deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData Privacy where rnf = genericRnf
+instance Binary Privacy
+
+data Permission =
+ PermissionPull
+ | PermissionPush
+ | PermissionAdmin
+ deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData Permission where rnf = genericRnf
+instance Binary Permission
+
+data SimpleTeam = SimpleTeam {
+ simpleTeamId :: !(Id Team)
+ ,simpleTeamUrl :: !Text
+ ,simpleTeamName :: !Text
+ ,simpleTeamSlug :: !(Name Team)
+ ,simpleTeamDescription :: !(Maybe Text)
+ ,simpleTeamPrivacy :: !(Maybe Privacy)
+ ,simpleTeamPermission :: !Permission
+ ,simpleTeamMembersUrl :: !Text
+ ,simpleTeamRepositoriesUrl :: !Text
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData SimpleTeam where rnf = genericRnf
+instance Binary SimpleTeam
+
+data Team = Team {
+ teamId :: !(Id Team)
+ ,teamUrl :: !Text
+ ,teamName :: !(Name Team)
+ ,teamSlug :: !Text
+ ,teamDescription :: !(Maybe Text)
+ ,teamPrivacy :: !(Maybe Privacy)
+ ,teamPermission :: !Permission
+ ,teamMembersUrl :: !Text
+ ,teamRepositoriesUrl :: !Text
+ ,teamMembersCount :: !Int
+ ,teamReposCount :: !Int
+ ,teamOrganization :: !SimpleOrganization
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData Team where rnf = genericRnf
+instance Binary Team
+
+data CreateTeam = CreateTeam {
+ createTeamName :: !(Name Team)
+ ,createTeamDescription :: !(Maybe Text)
+ ,createTeamRepoNames :: !(Vector (Name Repo))
+ {-,createTeamPrivacy :: Privacy-}
+ ,createTeamPermission :: Permission
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData CreateTeam where rnf = genericRnf
+instance Binary CreateTeam
+
+data EditTeam = EditTeam {
+ editTeamName :: !(Name Team)
+ ,editTeamDescription :: !(Maybe Text)
+ {-,editTeamPrivacy :: Privacy-}
+ ,editTeamPermission :: !Permission
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData EditTeam where rnf = genericRnf
+instance Binary EditTeam
+
+data Role =
+ RoleMaintainer
+ | RoleMember
+ deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData Role
+instance Binary Role
+
+data ReqState =
+ StatePending
+ | StateActive
+ deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData ReqState where rnf = genericRnf
+instance Binary ReqState
+
+data TeamMembership = TeamMembership {
+ teamMembershipUrl :: !Text,
+ teamMembershipRole :: !Role,
+ teamMembershipReqState :: !ReqState
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData TeamMembership where rnf = genericRnf
+instance Binary TeamMembership
+
+data CreateTeamMembership = CreateTeamMembership {
+ createTeamMembershipRole :: !Role
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData CreateTeamMembership where rnf = genericRnf
+instance Binary CreateTeamMembership
+
+-- JSON Instances
+
+instance FromJSON SimpleTeam where
+ parseJSON = withObject "SimpleTeam" $ \o ->
+ SimpleTeam <$> o .: "id"
+ <*> o .: "url"
+ <*> o .: "name"
+ <*> o .: "slug"
+ <*> o .:?"description" .!= Nothing
+ <*> o .:?"privacy" .!= Nothing
+ <*> o .: "permission"
+ <*> o .: "members_url"
+ <*> o .: "repositories_url"
+
+instance FromJSON Team where
+ parseJSON = withObject "Team" $ \o ->
+ Team <$> o .: "id"
+ <*> o .: "url"
+ <*> o .: "name"
+ <*> o .: "slug"
+ <*> o .:?"description" .!= Nothing
+ <*> o .:?"privacy" .!= Nothing
+ <*> o .: "permission"
+ <*> o .: "members_url"
+ <*> o .: "repositories_url"
+ <*> o .: "members_count"
+ <*> o .: "repos_count"
+ <*> o .: "organization"
+
+instance ToJSON CreateTeam where
+ toJSON (CreateTeam name desc repo_names {-privacy-} permissions) =
+ object [ "name" .= name
+ , "description" .= desc
+ , "repo_names" .= repo_names
+ {-, "privacy" .= privacy-}
+ , "permissions" .= permissions ]
+
+instance ToJSON EditTeam where
+ toJSON (EditTeam name desc {-privacy-} permissions) =
+ object [ "name" .= name
+ , "description" .= desc
+ {-, "privacy" .= privacy-}
+ , "permissions" .= permissions ]
+
+instance FromJSON TeamMembership where
+ parseJSON = withObject "TeamMembership" $ \o ->
+ TeamMembership <$> o .: "url"
+ <*> o .: "role"
+ <*> o .: "state"
+
+instance FromJSON CreateTeamMembership where
+ parseJSON = withObject "CreateTeamMembership" $ \o ->
+ CreateTeamMembership <$> o .: "role"
+
+instance ToJSON CreateTeamMembership where
+ toJSON (CreateTeamMembership { createTeamMembershipRole = role }) =
+ object [ "role" .= role ]
+
+instance FromJSON Role where
+ parseJSON (String attr) =
+ case attr of
+ "maintainer" -> return RoleMaintainer
+ "member" -> return RoleMember
+ _ -> fail "Unknown Role"
+ parseJSON _ = fail "Could not build Role"
+
+instance ToJSON Role where
+ toJSON RoleMaintainer = String "maintainer"
+ toJSON RoleMember = String "member"
+
+instance ToJSON Permission where
+ toJSON attr =
+ String $
+ case attr of
+ PermissionPull -> "pull"
+ PermissionPush -> "push"
+ PermissionAdmin -> "admin"
+
+instance FromJSON Permission where
+ parseJSON (String attr) =
+ case attr of
+ "pull" -> return PermissionPull
+ "push" -> return PermissionPush
+ "admin" -> return PermissionAdmin
+ _ -> fail "Unknown Permission Attribute"
+ parseJSON _ = fail "Could not build Permission"
+
+instance FromJSON Privacy where
+ parseJSON (String attr) =
+ case attr of
+ "secret" -> return PrivacySecret
+ "closed" -> return PrivacyClosed
+ _ -> fail "Unknown Privacy Attribute"
+ parseJSON _ = fail "Could not build Privacy"
+
+instance ToJSON Privacy where
+ toJSON attr =
+ String $
+ case attr of
+ PrivacySecret -> "secret"
+ PrivacyClosed -> "closed"
+
+instance FromJSON ReqState where
+ parseJSON (String attr) =
+ case attr of
+ "active" -> return StateActive
+ "pending" -> return StatePending
+ _ -> fail "Unknown ReqState"
+ parseJSON _ = fail "Could not build ReqState"
+
+instance ToJSON ReqState where
+ toJSON StateActive = String "active"
+ toJSON StatePending = String "pending"
diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Data/Webhooks.hs
@@ -0,0 +1,207 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+module GitHub.Data.Webhooks where
+
+import Prelude ()
+import Prelude.Compat
+
+import GitHub.Data.Id (Id)
+
+import Control.DeepSeq (NFData (..))
+import Control.DeepSeq.Generics (genericRnf)
+import Data.Aeson.Compat (FromJSON (..), ToJSON (..), Value (..), object,
+ withObject, (.:), (.=))
+import Data.Binary.Orphans (Binary)
+import Data.Data (Data, Typeable)
+import Data.Text (Text)
+import Data.Time (UTCTime)
+import Data.Vector (Vector)
+import GHC.Generics (Generic)
+
+import qualified Data.Map as M
+
+data RepoWebhook = RepoWebhook {
+ repoWebhookUrl :: !Text
+ ,repoWebhookTestUrl :: !Text
+ ,repoWebhookId :: !(Id RepoWebhook)
+ ,repoWebhookName :: !Text
+ ,repoWebhookActive :: !Bool
+ ,repoWebhookEvents :: !(Vector RepoWebhookEvent)
+ ,repoWebhookConfig :: !(M.Map Text Text)
+ ,repoWebhookLastResponse :: !RepoWebhookResponse
+ ,repoWebhookUpdatedAt :: !UTCTime
+ ,repoWebhookCreatedAt :: !UTCTime
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData RepoWebhook where rnf = genericRnf
+instance Binary RepoWebhook
+
+data RepoWebhookEvent =
+ WebhookWildcardEvent
+ | WebhookCommitCommentEvent
+ | WebhookCreateEvent
+ | WebhookDeleteEvent
+ | WebhookDeploymentEvent
+ | WebhookDeploymentStatusEvent
+ | WebhookForkEvent
+ | WebhookGollumEvent
+ | WebhookIssueCommentEvent
+ | WebhookIssuesEvent
+ | WebhookMemberEvent
+ | WebhookPageBuildEvent
+ | WebhookPublicEvent
+ | WebhookPullRequestReviewCommentEvent
+ | WebhookPullRequestEvent
+ | WebhookPushEvent
+ | WebhookReleaseEvent
+ | WebhookStatusEvent
+ | WebhookTeamAddEvent
+ | WebhookWatchEvent
+ deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData RepoWebhookEvent where rnf = genericRnf
+instance Binary RepoWebhookEvent
+
+data RepoWebhookResponse = RepoWebhookResponse {
+ repoWebhookResponseCode :: !(Maybe Int)
+ ,repoWebhookResponseStatus :: !Text
+ ,repoWebhookResponseMessage :: !(Maybe Text)
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData RepoWebhookResponse where rnf = genericRnf
+instance Binary RepoWebhookResponse
+
+data PingEvent = PingEvent {
+ pingEventZen :: !Text
+ ,pingEventHook :: !RepoWebhook
+ ,pingEventHookId :: !(Id RepoWebhook)
+} deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData PingEvent where rnf = genericRnf
+instance Binary PingEvent
+
+data NewRepoWebhook = NewRepoWebhook {
+ newRepoWebhookName :: !Text
+ ,newRepoWebhookConfig :: !(M.Map Text Text)
+ ,newRepoWebhookEvents :: !(Maybe (Vector RepoWebhookEvent))
+ ,newRepoWebhookActive :: !(Maybe Bool)
+} deriving (Eq, Ord, Show, Typeable, Data, Generic)
+
+instance NFData NewRepoWebhook where rnf = genericRnf
+instance Binary NewRepoWebhook
+
+data EditRepoWebhook = EditRepoWebhook {
+ editRepoWebhookConfig :: !(Maybe (M.Map Text Text))
+ ,editRepoWebhookEvents :: !(Maybe (Vector RepoWebhookEvent))
+ ,editRepoWebhookAddEvents :: !(Maybe (Vector RepoWebhookEvent))
+ ,editRepoWebhookRemoveEvents :: !(Maybe (Vector RepoWebhookEvent))
+ ,editRepoWebhookActive :: !(Maybe Bool)
+} deriving (Eq, Ord, Show, Typeable, Data, Generic)
+
+instance NFData EditRepoWebhook where rnf = genericRnf
+instance Binary EditRepoWebhook
+
+-- JSON instances
+
+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 RepoWebhook where
+ parseJSON = withObject "RepoWebhook" $ \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"
+
+instance FromJSON RepoWebhookResponse where
+ parseJSON = withObject "RepoWebhookResponse" $ \o ->
+ RepoWebhookResponse <$> o .: "code"
+ <*> o .: "status"
+ <*> o .: "message"
+
+instance ToJSON NewRepoWebhook where
+ toJSON (NewRepoWebhook { newRepoWebhookName = name
+ , newRepoWebhookConfig = config
+ , newRepoWebhookEvents = events
+ , newRepoWebhookActive = active
+
+ }) = object
+ [ "name" .= name
+ , "config" .= config
+ , "events" .= events
+ , "active" .= active
+ ]
+
+instance ToJSON EditRepoWebhook where
+ toJSON (EditRepoWebhook { editRepoWebhookConfig = config
+ , editRepoWebhookEvents = events
+ , editRepoWebhookAddEvents = addEvents
+ , editRepoWebhookRemoveEvents = removeEvents
+ , editRepoWebhookActive = active
+ }) = object
+ [ "config" .= config
+ , "events" .= events
+ , "add_events" .= addEvents
+ , "remove_events" .= removeEvents
+ , "active" .= active
+ ]
+
+instance FromJSON PingEvent where
+ parseJSON = withObject "PingEvent" $ \o ->
+ PingEvent <$> o .: "zen"
+ <*> o .: "hook"
+ <*> o .: "hook_id"
diff --git a/src/GitHub/Data/Webhooks/Validate.hs b/src/GitHub/Data/Webhooks/Validate.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Data/Webhooks/Validate.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- Verification of incomming webhook payloads, as described at
+--
+module GitHub.Data.Webhooks.Validate (
+ isValidPayload
+) where
+
+import Prelude ()
+import Prelude.Compat
+
+import Crypto.Hash
+import Data.Byteable (constEqBytes, toBytes)
+import qualified Data.ByteString.Base16 as Hex
+import qualified Data.ByteString.Char8 as BS
+import Data.Monoid
+
+
+-- | Validates a given payload against a given HMAC hexdigest using a given
+-- secret.
+-- Returns 'True' iff the given hash is non-empty and it's a valid signature of
+-- the payload.
+isValidPayload
+ :: String -- ^ the secret
+ -> Maybe String -- ^ the hash provided by the remote party
+ -- in @X-Hub-Signature@ (if any),
+ -- including the 'sha1=...' prefix
+ -> BS.ByteString -- ^ the body
+ -> Bool
+isValidPayload secret shaOpt payload = maybe False (constEqBytes sign) shaOptBS
+ where
+ shaOptBS = BS.pack <$> shaOpt
+ hexDigest = Hex.encode . toBytes . hmacGetDigest
+
+ hm = hmac (BS.pack secret) payload :: HMAC SHA1
+ sign = "sha1=" <> hexDigest hm
diff --git a/src/GitHub/Endpoints/Activity/Starring.hs b/src/GitHub/Endpoints/Activity/Starring.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Endpoints/Activity/Starring.hs
@@ -0,0 +1,57 @@
+{-# LANGUAGE DataKinds #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- The repo starring API as described on
+-- .
+module GitHub.Endpoints.Activity.Starring (
+ stargazersFor,
+ stargazersForR,
+ reposStarredBy,
+ reposStarredByR,
+ myStarred,
+ myStarredR,
+ module GitHub.Data,
+ ) where
+
+import Data.Vector (Vector)
+import GitHub.Auth
+import GitHub.Data
+import GitHub.Request
+
+-- | The list of users that have starred the specified Github repo.
+--
+-- > userInfoFor' Nothing "mike-burns"
+stargazersFor :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser))
+stargazersFor auth user repo =
+ executeRequestMaybe auth $ stargazersForR user repo Nothing
+
+-- | List Stargazers.
+-- See
+stargazersForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector SimpleUser)
+stargazersForR user repo =
+ PagedQuery ["repos", toPathPart user, toPathPart repo, "stargazers"] []
+
+-- | All the public repos starred by the specified user.
+--
+-- > reposStarredBy Nothing "croaky"
+reposStarredBy :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Repo))
+reposStarredBy auth user =
+ executeRequestMaybe auth $ reposStarredByR user Nothing
+
+-- | List repositories being starred.
+-- See
+reposStarredByR :: Name Owner -> Maybe Count -> Request k (Vector Repo)
+reposStarredByR user =
+ PagedQuery ["users", toPathPart user, "starred"] []
+
+-- | All the repos starred by the authenticated user.
+myStarred :: Auth -> IO (Either Error (Vector Repo))
+myStarred auth =
+ executeRequest auth $ myStarredR Nothing
+
+-- | All the repos starred by the authenticated user.
+myStarredR :: Maybe Count -> Request 'True (Vector Repo)
+myStarredR = PagedQuery ["user", "starred"] []
diff --git a/src/GitHub/Endpoints/Activity/Watching.hs b/src/GitHub/Endpoints/Activity/Watching.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Endpoints/Activity/Watching.hs
@@ -0,0 +1,61 @@
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- The repo watching API as described on
+-- .
+module GitHub.Endpoints.Activity.Watching (
+ watchersFor,
+ watchersFor',
+ watchersForR,
+ reposWatchedBy,
+ reposWatchedBy',
+ reposWatchedByR,
+ module GitHub.Data,
+) where
+
+import Data.Vector (Vector)
+import GitHub.Auth
+import GitHub.Data
+import GitHub.Request
+
+-- | The list of users that are watching the specified Github repo.
+--
+-- > watchersFor "thoughtbot" "paperclip"
+watchersFor :: Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser))
+watchersFor = watchersFor' Nothing
+
+-- | The list of users that are watching the specified Github repo.
+-- With authentication
+--
+-- > watchersFor' (Just (User (user, password))) "thoughtbot" "paperclip"
+watchersFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser))
+watchersFor' auth user repo =
+ executeRequestMaybe auth $ watchersForR user repo Nothing
+
+-- | List watchers.
+-- See
+watchersForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector SimpleUser)
+watchersForR user repo limit =
+ PagedQuery ["repos", toPathPart user, toPathPart repo, "watchers"] [] limit
+
+-- | All the public repos watched by the specified user.
+--
+-- > reposWatchedBy "croaky"
+reposWatchedBy :: Name Owner -> IO (Either Error (Vector Repo))
+reposWatchedBy = reposWatchedBy' Nothing
+
+-- | All the public repos watched by the specified user.
+-- With authentication
+--
+-- > reposWatchedBy' (Just (User (user, password))) "croaky"
+reposWatchedBy' :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Repo))
+reposWatchedBy' auth user =
+ executeRequestMaybe auth $ reposWatchedByR user Nothing
+
+-- | List repositories being watched.
+-- See
+reposWatchedByR :: Name Owner -> Maybe Count -> Request k (Vector Repo)
+reposWatchedByR user =
+ PagedQuery ["users", toPathPart user, "subscriptions"] []
diff --git a/src/GitHub/Endpoints/Gists.hs b/src/GitHub/Endpoints/Gists.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Endpoints/Gists.hs
@@ -0,0 +1,56 @@
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- The gists API as described at .
+module GitHub.Endpoints.Gists (
+ gists,
+ gists',
+ gistsR,
+ gist,
+ gist',
+ gistR,
+ module GitHub.Data,
+ ) where
+
+import Data.Vector (Vector)
+import GitHub.Data
+import GitHub.Request
+
+-- | The list of all gists created by the user
+--
+-- > gists' (Just ("github-username", "github-password")) "mike-burns"
+gists' :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Gist))
+gists' auth user =
+ executeRequestMaybe auth $ gistsR user Nothing
+
+-- | The list of all public gists created by the user.
+--
+-- > gists "mike-burns"
+gists :: Name Owner -> IO (Either Error (Vector Gist))
+gists = gists' Nothing
+
+-- | List gists.
+-- See
+gistsR :: Name Owner -> Maybe Count -> Request k (Vector Gist)
+gistsR user = PagedQuery ["users", toPathPart user, "gists"] []
+
+-- | A specific gist, given its id, with authentication credentials
+--
+-- > gist' (Just ("github-username", "github-password")) "225074"
+gist' :: Maybe Auth -> Name Gist -> IO (Either Error Gist)
+gist' auth gid =
+ executeRequestMaybe auth $ gistR gid
+
+-- | A specific gist, given its id.
+--
+-- > gist "225074"
+gist :: Name Gist -> IO (Either Error Gist)
+gist = gist' Nothing
+
+-- | Query a single gist.
+-- See
+gistR :: Name Gist ->Request k Gist
+gistR gid =
+ Query ["gists", toPathPart gid] []
diff --git a/src/GitHub/Endpoints/Gists/Comments.hs b/src/GitHub/Endpoints/Gists/Comments.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Endpoints/Gists/Comments.hs
@@ -0,0 +1,45 @@
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- The loving comments people have left on Gists, described on
+-- .
+module GitHub.Endpoints.Gists.Comments (
+ commentsOn,
+ commentsOnR,
+ comment,
+ gistCommentR,
+ module GitHub.Data,
+ ) where
+
+import Data.Vector (Vector)
+
+import GitHub.Data
+import GitHub.Request
+
+-- | All the comments on a Gist, given the Gist ID.
+--
+-- > commentsOn "1174060"
+commentsOn :: Name Gist -> IO (Either Error (Vector GistComment))
+commentsOn gid =
+ executeRequest' $ commentsOnR gid Nothing
+
+-- | List comments on a gist.
+-- See
+commentsOnR :: Name Gist -> Maybe Count -> Request k (Vector GistComment)
+commentsOnR gid =
+ PagedQuery ["gists", toPathPart gid, "comments"] []
+
+-- | A specific comment, by the comment ID.
+--
+-- > comment (Id 62449)
+comment :: Id GistComment -> IO (Either Error GistComment)
+comment cid =
+ executeRequest' $ gistCommentR cid
+
+-- | Query a single comment.
+-- See
+gistCommentR :: Id GistComment -> Request k GistComment
+gistCommentR cid =
+ Query ["gists", "comments", toPathPart cid] []
diff --git a/src/GitHub/Endpoints/GitData/Blobs.hs b/src/GitHub/Endpoints/GitData/Blobs.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Endpoints/GitData/Blobs.hs
@@ -0,0 +1,35 @@
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- The API for dealing with git blobs from Github repos, as described in
+-- .
+module GitHub.Endpoints.GitData.Blobs (
+ blob,
+ blob',
+ blobR,
+ module GitHub.Data,
+ ) where
+
+import GitHub.Data
+import GitHub.Request
+
+-- | Query a blob by SHA1.
+--
+-- > blob' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9"
+blob' :: Maybe Auth -> Name Owner -> Name Repo -> Name Blob -> IO (Either Error Blob)
+blob' auth user repo sha =
+ executeRequestMaybe auth $ blobR user repo sha
+
+-- | Query a blob by SHA1.
+--
+-- > blob "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9"
+blob :: Name Owner -> Name Repo -> Name Blob -> IO (Either Error Blob)
+blob = blob' Nothing
+
+-- | Query a blob.
+-- See
+blobR :: Name Owner -> Name Repo -> Name Blob -> Request k Blob
+blobR user repo sha =
+ Query ["repos", toPathPart user, toPathPart repo, "git", "blobs", toPathPart sha] []
diff --git a/src/GitHub/Endpoints/GitData/Commits.hs b/src/GitHub/Endpoints/GitData/Commits.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Endpoints/GitData/Commits.hs
@@ -0,0 +1,28 @@
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- The API for underlying git commits of a Github repo, as described on
+-- .
+module GitHub.Endpoints.GitData.Commits (
+ commit,
+ gitCommitR,
+ module GitHub.Data,
+) where
+
+import GitHub.Data
+import GitHub.Request
+
+-- | A single commit, by SHA1.
+--
+-- > commit "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9"
+commit :: Name Owner -> Name Repo -> Name GitCommit -> IO (Either Error GitCommit)
+commit user repo sha =
+ executeRequest' $ gitCommitR user repo sha
+
+-- | Query a commit.
+-- See
+gitCommitR :: Name Owner -> Name Repo -> Name GitCommit -> Request k GitCommit
+gitCommitR user repo sha =
+ Query ["repos", toPathPart user, toPathPart repo, "git", "commits", toPathPart sha] []
diff --git a/src/GitHub/Endpoints/GitData/References.hs b/src/GitHub/Endpoints/GitData/References.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Endpoints/GitData/References.hs
@@ -0,0 +1,89 @@
+{-# LANGUAGE DataKinds #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- The underlying git references on a Github repo, exposed for the world to
+-- see. The git internals documentation will also prove handy for understanding
+-- these. API documentation at .
+module GitHub.Endpoints.GitData.References (
+ reference,
+ reference',
+ referenceR,
+ references,
+ references',
+ referencesR,
+ createReference,
+ createReferenceR,
+ namespacedReferences,
+ module GitHub.Data,
+ ) where
+
+import Data.Aeson.Compat (encode)
+import Data.Vector (Vector)
+
+import GitHub.Data
+import GitHub.Request
+
+-- | A single reference by the ref name.
+--
+-- > reference' (Just ("github-username", "github-password")) "mike-burns" "github" "heads/master"
+reference' :: Maybe Auth -> Name Owner -> Name Repo -> Name GitReference -> IO (Either Error GitReference)
+reference' auth user repo ref =
+ executeRequestMaybe auth $ referenceR user repo ref
+
+-- | A single reference by the ref name.
+--
+-- > reference "mike-burns" "github" "heads/master"
+reference :: Name Owner -> Name Repo -> Name GitReference -> IO (Either Error GitReference)
+reference = reference' Nothing
+
+-- | Query a reference.
+-- See
+referenceR :: Name Owner -> Name Repo -> Name GitReference -> Request k GitReference
+referenceR user repo ref =
+ Query ["repos", toPathPart user, toPathPart repo, "git", "refs", toPathPart ref] []
+
+-- | The history of references for a repo.
+--
+-- > references "mike-burns" "github"
+references' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector GitReference))
+references' auth user repo =
+ executeRequestMaybe auth $ referencesR user repo Nothing
+
+-- | The history of references for a repo.
+--
+-- > references "mike-burns" "github"
+references :: Name Owner -> Name Repo -> IO (Either Error (Vector GitReference))
+references = references' Nothing
+
+-- | Query all References.
+-- See
+referencesR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector GitReference)
+referencesR user repo =
+ PagedQuery ["repos", toPathPart user, toPathPart repo, "git", "refs"] []
+
+-- | Create a reference.
+createReference :: Auth -> Name Owner -> Name Repo -> NewGitReference -> IO (Either Error GitReference)
+createReference auth user repo newRef =
+ executeRequest auth $ createReferenceR user repo newRef
+
+-- | Create a reference.
+-- See
+createReferenceR :: Name Owner -> Name Repo -> NewGitReference -> Request 'True GitReference
+createReferenceR user repo newRef =
+ Command Post ["repos", toPathPart user, toPathPart repo , "git", "refs"] (encode newRef)
+
+-- | Limited references by a namespace.
+--
+-- > namespacedReferences "thoughtbot" "paperclip" "tags"
+namespacedReferences :: Name Owner -> Name Repo -> String -> IO (Either Error [GitReference])
+namespacedReferences user repo namespace =
+ executeRequest' $ namespacedReferencesR user repo namespace
+
+-- | Query namespaced references.
+-- See
+namespacedReferencesR :: Name Owner -> Name Repo -> String -> Request k [GitReference]
+namespacedReferencesR user repo namespace =
+ Query ["repos", toPathPart user, toPathPart repo, "git", "refs", namespace] []
diff --git a/src/GitHub/Endpoints/GitData/Trees.hs b/src/GitHub/Endpoints/GitData/Trees.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Endpoints/GitData/Trees.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE OverloadedStrings #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- The underlying tree of SHA1s and files that make up a git repo. The API is
+-- described on .
+module GitHub.Endpoints.GitData.Trees (
+ tree,
+ tree',
+ treeR,
+ nestedTree,
+ nestedTree',
+ nestedTreeR,
+ module GitHub.Data,
+ ) where
+
+import GitHub.Data
+import GitHub.Request
+
+-- | A tree for a SHA1.
+--
+-- > tree (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844"
+tree' :: Maybe Auth -> Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree)
+tree' auth user repo sha =
+ executeRequestMaybe auth $ treeR user repo sha
+
+-- | A tree for a SHA1.
+--
+-- > tree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844"
+tree :: Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree)
+tree = tree' Nothing
+
+-- | Query a Tree.
+-- See
+treeR :: Name Owner -> Name Repo -> Name Tree -> Request k Tree
+treeR user repo sha =
+ Query ["repos", toPathPart user, toPathPart repo, "git", "trees", toPathPart sha] []
+
+-- | A recursively-nested tree for a SHA1.
+--
+-- > nestedTree' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844"
+nestedTree' :: Maybe Auth -> Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree)
+nestedTree' auth user repo sha =
+ executeRequestMaybe auth $ nestedTreeR user repo sha
+
+-- | A recursively-nested tree for a SHA1.
+--
+-- > nestedTree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844"
+nestedTree :: Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree)
+nestedTree = nestedTree' Nothing
+
+-- | Query a Tree Recursively.
+-- See
+nestedTreeR :: Name Owner -> Name Repo -> Name Tree -> Request k Tree
+nestedTreeR user repo sha =
+ Query ["repos", toPathPart user, toPathPart repo, "git", "trees", toPathPart sha] [("recursive", Just "1")]
diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Endpoints/Issues.hs
@@ -0,0 +1,136 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- The issues API as described on .
+module GitHub.Endpoints.Issues (
+ issue,
+ issue',
+ issueR,
+ issuesForRepo,
+ issuesForRepo',
+ issuesForRepoR,
+ IssueLimitation(..),
+ createIssue,
+ createIssueR,
+ newIssue,
+ editIssue,
+ editIssueR,
+ editOfIssue,
+ module GitHub.Data,
+ ) where
+
+import GitHub.Data
+import GitHub.Request
+
+import Data.Aeson.Compat (encode)
+import Data.List (intercalate)
+import Data.Text (Text)
+import Data.Time.ISO8601 (formatISO8601)
+import Data.Vector (Vector)
+
+import qualified Data.ByteString.Char8 as BS8
+
+-- | Details on a specific issue, given the repo owner and name, and the issue
+-- number.'
+--
+-- > issue' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "462"
+issue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error Issue)
+issue' auth user reqRepoName reqIssueNumber =
+ executeRequestMaybe auth $ issueR user reqRepoName reqIssueNumber
+
+-- | Details on a specific issue, given the repo owner and name, and the issue
+-- number.
+--
+-- > issue "thoughtbot" "paperclip" (Id "462")
+issue :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error Issue)
+issue = issue' Nothing
+
+-- | Query a single issue.
+-- See
+issueR :: Name Owner -> Name Repo -> Id Issue -> Request k Issue
+issueR user reqRepoName reqIssueNumber =
+ Query ["repos", toPathPart user, toPathPart reqRepoName, "issues", toPathPart reqIssueNumber] []
+
+-- | All issues for a repo (given the repo owner and name), with optional
+-- restrictions as described in the @IssueLimitation@ data type.
+--
+-- > issuesForRepo' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending]
+issuesForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> [IssueLimitation] -> IO (Either Error (Vector Issue))
+issuesForRepo' auth user reqRepoName issueLimitations =
+ executeRequestMaybe auth $ issuesForRepoR user reqRepoName issueLimitations Nothing
+
+-- | All issues for a repo (given the repo owner and name), with optional
+-- restrictions as described in the @IssueLimitation@ data type.
+--
+-- > issuesForRepo "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending]
+issuesForRepo :: Name Owner -> Name Repo -> [IssueLimitation] -> IO (Either Error (Vector Issue))
+issuesForRepo = issuesForRepo' Nothing
+
+-- | List issues for a repository.
+-- See
+issuesForRepoR :: Name Owner -> Name Repo -> [IssueLimitation] -> Maybe Count -> Request k (Vector Issue)
+issuesForRepoR user reqRepoName issueLimitations =
+ PagedQuery ["repos", toPathPart user, toPathPart reqRepoName, "issues"] qs
+ where
+ qs = map convert issueLimitations
+
+ convert AnyMilestone = ("milestone", Just "*")
+ convert NoMilestone = ("milestone", Just "none")
+ convert (MilestoneId n) = ("milestone", Just . BS8.pack $ show n)
+ convert Open = ("state", Just "open")
+ convert OnlyClosed = ("state", Just "closed")
+ convert Unassigned = ("assignee", Just "none")
+ convert AnyAssignment = ("assignee", Just "")
+ convert (AssignedTo u) = ("assignee", Just $ BS8.pack u)
+ convert (Mentions u) = ("mentioned", Just $ BS8.pack u)
+ convert (Labels l) = ("labels", Just . BS8.pack $ intercalate "," l)
+ convert Ascending = ("direction", Just "asc")
+ convert Descending = ("direction", Just "desc")
+ convert (PerPage n) = ("per_page", Just . BS8.pack $ show n)
+ convert (Since t) = ("since", Just . BS8.pack $ formatISO8601 t)
+
+-- Creating new issues.
+
+newIssue :: Text -> NewIssue
+newIssue title = NewIssue title Nothing Nothing Nothing Nothing
+
+
+-- | Create a new issue.
+--
+-- > createIssue (User (user, password)) user repo
+-- > (newIssue "some_repo") {...}
+createIssue :: Auth -> Name Owner -> Name Repo -> NewIssue
+ -> IO (Either Error Issue)
+createIssue auth user repo ni =
+ executeRequest auth $ createIssueR user repo ni
+
+-- | Create an issue.
+-- See
+createIssueR :: Name Owner -> Name Repo -> NewIssue -> Request 'True Issue
+createIssueR user repo =
+ Command Post ["repos", toPathPart user, toPathPart repo, "issues"] . encode
+
+-- Editing issues.
+
+editOfIssue :: EditIssue
+editOfIssue = EditIssue Nothing Nothing Nothing Nothing Nothing Nothing
+
+-- | Edit an issue.
+--
+-- > editIssue (User (user, password)) user repo issue
+-- > editOfIssue {...}
+editIssue :: Auth -> Name Owner -> Name Repo -> Id Issue -> EditIssue
+ -> IO (Either Error Issue)
+editIssue auth user repo iss edit =
+ executeRequest auth $ editIssueR user repo iss edit
+
+-- | Edit an issue.
+-- See
+editIssueR :: Name Owner -> Name Repo -> Id Issue -> EditIssue -> Request 'True Issue
+editIssueR user repo iss =
+ Command Patch ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss] . encode
diff --git a/src/GitHub/Endpoints/Issues/Comments.hs b/src/GitHub/Endpoints/Issues/Comments.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Endpoints/Issues/Comments.hs
@@ -0,0 +1,93 @@
+{-# LANGUAGE DataKinds #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- The Github issue comments API from
+-- .
+module GitHub.Endpoints.Issues.Comments (
+ comment,
+ commentR,
+ comments,
+ commentsR,
+ comments',
+ createComment,
+ createCommentR,
+ editComment,
+ editCommentR,
+ module GitHub.Data,
+ ) where
+
+import Data.Aeson.Compat (encode)
+import Data.Text (Text)
+import Data.Vector (Vector)
+
+import GitHub.Data
+import GitHub.Request
+
+-- | A specific comment, by ID.
+--
+-- > comment "thoughtbot" "paperclip" 1468184
+comment :: Name Owner -> Name Repo -> Id Comment -> IO (Either Error IssueComment)
+comment user repo cid =
+ executeRequest' $ commentR user repo cid
+
+-- | Query a single comment.
+-- See
+commentR :: Name Owner -> Name Repo -> Id Comment -> Request k IssueComment
+commentR user repo cid =
+ Query ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart cid] []
+
+-- | All comments on an issue, by the issue's number.
+--
+-- > comments "thoughtbot" "paperclip" 635
+comments :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueComment))
+comments = comments' Nothing
+
+-- | All comments on an issue, by the issue's number, using authentication.
+--
+-- > comments' (User (user, password)) "thoughtbot" "paperclip" 635
+comments' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueComment))
+comments' auth user repo iid =
+ executeRequestMaybe auth $ commentsR user repo iid Nothing
+
+-- | List comments on an issue.
+-- See
+commentsR :: Name Owner -> Name Repo -> Id Issue -> Maybe Count -> Request k (Vector IssueComment)
+commentsR user repo iid =
+ PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "comments"] []
+
+-- | Create a new comment.
+--
+-- > createComment (User (user, password)) user repo issue
+-- > "some words"
+createComment :: Auth -> Name Owner -> Name Repo -> Id Issue -> Text
+ -> IO (Either Error Comment)
+createComment auth user repo iss body =
+ executeRequest auth $ createCommentR user repo iss body
+
+-- | Create a comment.
+-- See
+createCommentR :: Name Owner -> Name Repo -> Id Issue -> Text -> Request 'True Comment
+createCommentR user repo iss body =
+ Command Post parts (encode $ NewComment body)
+ where
+ parts = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss, "comments"]
+
+-- | Edit a comment.
+--
+-- > editComment (User (user, password)) user repo commentid
+-- > "new words"
+editComment :: Auth -> Name Owner -> Name Repo -> Id Comment -> Text
+ -> IO (Either Error Comment)
+editComment auth user repo commid body =
+ executeRequest auth $ editCommentR user repo commid body
+
+-- | Edit a comment.
+-- See
+editCommentR :: Name Owner -> Name Repo -> Id Comment -> Text -> Request 'True Comment
+editCommentR user repo commid body =
+ Command Patch parts (encode $ EditComment body)
+ where
+ parts = ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart commid]
diff --git a/src/GitHub/Endpoints/Issues/Events.hs b/src/GitHub/Endpoints/Issues/Events.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Endpoints/Issues/Events.hs
@@ -0,0 +1,81 @@
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- The Github issue events API, which is described on
+--
+module GitHub.Endpoints.Issues.Events (
+ eventsForIssue,
+ eventsForIssue',
+ eventsForIssueR,
+ eventsForRepo,
+ eventsForRepo',
+ eventsForRepoR,
+ event,
+ event',
+ eventR,
+ module GitHub.Data,
+ ) where
+
+import Data.Vector (Vector)
+
+import GitHub.Data
+import GitHub.Request
+
+-- | All events that have happened on an issue.
+--
+-- > eventsForIssue "thoughtbot" "paperclip" 49
+eventsForIssue :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector Event))
+eventsForIssue = eventsForIssue' Nothing
+
+-- | All events that have happened on an issue, using authentication.
+--
+-- > eventsForIssue' (User (user, password)) "thoughtbot" "paperclip" 49
+eventsForIssue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector Event))
+eventsForIssue' auth user repo iid =
+ executeRequestMaybe auth $ eventsForIssueR user repo iid Nothing
+
+-- | List events for an issue.
+-- See
+eventsForIssueR :: Name Owner -> Name Repo -> Id Issue -> Maybe Count -> Request k (Vector Event)
+eventsForIssueR user repo iid =
+ PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "events"] []
+
+-- | All the events for all issues in a repo.
+--
+-- > eventsForRepo "thoughtbot" "paperclip"
+eventsForRepo :: Name Owner -> Name Repo -> IO (Either Error (Vector Event))
+eventsForRepo = eventsForRepo' Nothing
+
+-- | All the events for all issues in a repo, using authentication.
+--
+-- > eventsForRepo' (User (user, password)) "thoughtbot" "paperclip"
+eventsForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Event))
+eventsForRepo' auth user repo =
+ executeRequestMaybe auth $ eventsForRepoR user repo Nothing
+
+-- | List events for a repository.
+-- See
+eventsForRepoR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Event)
+eventsForRepoR user repo =
+ PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", "events"] []
+
+-- | Details on a specific event, by the event's ID.
+--
+-- > event "thoughtbot" "paperclip" 5335772
+event :: Name Owner -> Name Repo -> Id Event -> IO (Either Error Event)
+event = event' Nothing
+
+-- | Details on a specific event, by the event's ID, using authentication.
+--
+-- > event' (User (user, password)) "thoughtbot" "paperclip" 5335772
+event' :: Maybe Auth -> Name Owner -> Name Repo -> Id Event -> IO (Either Error Event)
+event' auth user repo eid =
+ executeRequestMaybe auth $ eventR user repo eid
+
+-- | Query a single event.
+-- See
+eventR :: Name Owner -> Name Repo -> Id Event -> Request k Event
+eventR user repo eid =
+ Query ["repos", toPathPart user, toPathPart repo, "issues", "events", show eid] []
diff --git a/src/GitHub/Endpoints/Issues/Labels.hs b/src/GitHub/Endpoints/Issues/Labels.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Endpoints/Issues/Labels.hs
@@ -0,0 +1,260 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- The API for dealing with labels on Github issues as described on
+-- .
+module GitHub.Endpoints.Issues.Labels (
+ labelsOnRepo,
+ labelsOnRepo',
+ labelsOnRepoR,
+ label,
+ label',
+ labelR,
+ createLabel,
+ createLabelR,
+ updateLabel,
+ updateLabelR,
+ deleteLabel,
+ deleteLabelR,
+ labelsOnIssue,
+ labelsOnIssue',
+ labelsOnIssueR,
+ addLabelsToIssue,
+ addLabelsToIssueR,
+ removeLabelFromIssue,
+ removeLabelFromIssueR,
+ replaceAllLabelsForIssue,
+ replaceAllLabelsForIssueR,
+ removeAllLabelsFromIssue,
+ removeAllLabelsFromIssueR,
+ labelsOnMilestone,
+ labelsOnMilestone',
+ labelsOnMilestoneR,
+ module GitHub.Data,
+ ) where
+
+import Prelude ()
+import Prelude.Compat
+
+import Data.Aeson.Compat (encode, object, (.=))
+import Data.Foldable (toList)
+import Data.Vector (Vector)
+
+import GitHub.Data
+import GitHub.Request
+
+-- | All the labels available to use on any issue in the repo.
+--
+-- > labelsOnRepo "thoughtbot" "paperclip"
+labelsOnRepo :: Name Owner -> Name Repo -> IO (Either Error (Vector IssueLabel))
+labelsOnRepo = labelsOnRepo' Nothing
+
+-- | All the labels available to use on any issue in the repo using authentication.
+--
+-- > labelsOnRepo' (Just (User (user password))) "thoughtbot" "paperclip"
+labelsOnRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector IssueLabel))
+labelsOnRepo' auth user repo =
+ executeRequestMaybe auth $ labelsOnRepoR user repo Nothing
+
+-- | List all labels for this repository.
+-- See
+labelsOnRepoR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector IssueLabel)
+labelsOnRepoR user repo =
+ PagedQuery ["repos", toPathPart user, toPathPart repo, "labels"] []
+
+-- | A label by name.
+--
+-- > label "thoughtbot" "paperclip" "bug"
+label :: Name Owner -> Name Repo -> Name IssueLabel -> IO (Either Error IssueLabel)
+label = label' Nothing
+
+-- | A label by name using authentication.
+--
+-- > label' (Just (User (user password))) "thoughtbot" "paperclip" "bug"
+label' :: Maybe Auth -> Name Owner -> Name Repo -> Name IssueLabel -> IO (Either Error IssueLabel)
+label' auth user repo lbl =
+ executeRequestMaybe auth $ labelR user repo lbl
+
+-- | Query a single label.
+-- See
+labelR :: Name Owner -> Name Repo -> Name IssueLabel -> Request k IssueLabel
+labelR user repo lbl =
+ Query ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] []
+
+-- | Create a label
+--
+-- > createLabel (User (user password)) "thoughtbot" "paperclip" "bug" "f29513"
+createLabel :: Auth -> Name Owner -> Name Repo -> Name IssueLabel -> String -> IO (Either Error IssueLabel)
+createLabel auth user repo lbl color =
+ executeRequest auth $ createLabelR user repo lbl color
+
+-- | Create a label.
+-- See
+createLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> String -> Request 'True IssueLabel
+createLabelR user repo lbl color =
+ Command Post paths $ encode body
+ where
+ paths = ["repos", toPathPart user, toPathPart repo, "labels"]
+ body = object ["name" .= untagName lbl, "color" .= color]
+
+-- | Update a label
+--
+-- > updateLabel (User (user password)) "thoughtbot" "paperclip" "bug" "new-bug" "ff1111"
+updateLabel :: Auth
+ -> Name Owner
+ -> Name Repo
+ -> Name IssueLabel -- ^ old label name
+ -> Name IssueLabel -- ^ new label name
+ -> String -- ^ new color
+ -> IO (Either Error IssueLabel)
+updateLabel auth user repo oldLbl newLbl color =
+ executeRequest auth $ updateLabelR user repo oldLbl newLbl color
+
+-- | Update a label.
+-- See
+updateLabelR :: Name Owner
+ -> Name Repo
+ -> Name IssueLabel -- ^ old label name
+ -> Name IssueLabel -- ^ new label name
+ -> String -- ^ new color
+ -> Request 'True IssueLabel
+updateLabelR user repo oldLbl newLbl color =
+ Command Patch paths (encode body)
+ where
+ paths = ["repos", toPathPart user, toPathPart repo, "labels", toPathPart oldLbl]
+ body = object ["name" .= untagName newLbl, "color" .= color]
+
+-- | Delete a label
+--
+-- > deleteLabel (User (user password)) "thoughtbot" "paperclip" "bug"
+deleteLabel :: Auth -> Name Owner -> Name Repo -> Name IssueLabel -> IO (Either Error ())
+deleteLabel auth user repo lbl =
+ executeRequest auth $ deleteLabelR user repo lbl
+
+-- | Delete a label.
+-- See
+deleteLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> Request 'True ()
+deleteLabelR user repo lbl =
+ Command Delete ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] mempty
+
+-- | The labels on an issue in a repo.
+--
+-- > labelsOnIssue "thoughtbot" "paperclip" 585
+labelsOnIssue :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueLabel))
+labelsOnIssue = labelsOnIssue' Nothing
+
+-- | The labels on an issue in a repo using authentication.
+--
+-- > labelsOnIssue' (Just (User (user password))) "thoughtbot" "paperclip" (Id 585)
+labelsOnIssue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueLabel))
+labelsOnIssue' auth user repo iid =
+ executeRequestMaybe auth $ labelsOnIssueR user repo iid Nothing
+
+-- | List labels on an issue.
+-- See
+labelsOnIssueR :: Name Owner -> Name Repo -> Id Issue -> Maybe Count -> Request k (Vector IssueLabel)
+labelsOnIssueR user repo iid =
+ PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] []
+
+-- | Add labels to an issue.
+--
+-- > addLabelsToIssue (User (user password)) "thoughtbot" "paperclip" (Id 585) ["Label1" "Label2"]
+addLabelsToIssue :: Foldable f
+ => Auth
+ -> Name Owner
+ -> Name Repo
+ -> Id Issue
+ -> f (Name IssueLabel)
+ -> IO (Either Error (Vector IssueLabel))
+addLabelsToIssue auth user repo iid lbls =
+ executeRequest auth $ addLabelsToIssueR user repo iid lbls
+
+-- | Add lables to an issue.
+-- See
+addLabelsToIssueR :: Foldable f
+ => Name Owner
+ -> Name Repo
+ -> Id Issue
+ -> f (Name IssueLabel)
+ -> Request 'True (Vector IssueLabel)
+addLabelsToIssueR user repo iid lbls =
+ Command Post paths (encode $ toList lbls)
+ where
+ paths = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"]
+
+-- | Remove a label from an issue.
+--
+-- > removeLabelFromIssue (User (user password)) "thoughtbot" "paperclip" (Id 585) "bug"
+removeLabelFromIssue :: Auth -> Name Owner -> Name Repo -> Id Issue -> Name IssueLabel -> IO (Either Error ())
+removeLabelFromIssue auth user repo iid lbl =
+ executeRequest auth $ removeLabelFromIssueR user repo iid lbl
+
+-- | Remove a label from an issue.
+-- See
+removeLabelFromIssueR :: Name Owner -> Name Repo -> Id Issue -> Name IssueLabel -> Request 'True ()
+removeLabelFromIssueR user repo iid lbl =
+ Command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels", toPathPart lbl] mempty
+
+-- | Replace all labels on an issue. Sending an empty list will remove all labels from the issue.
+--
+-- > replaceAllLabelsForIssue (User (user password)) "thoughtbot" "paperclip" (Id 585) ["Label1" "Label2"]
+replaceAllLabelsForIssue :: Foldable f
+ => Auth
+ -> Name Owner
+ -> Name Repo
+ -> Id Issue
+ -> f (Name IssueLabel)
+ -> IO (Either Error (Vector IssueLabel))
+replaceAllLabelsForIssue auth user repo iid lbls =
+ executeRequest auth $ replaceAllLabelsForIssueR user repo iid lbls
+
+-- | Replace all labels on an issue.
+-- See
+--
+-- Sending an empty list will remove all labels from the issue.
+replaceAllLabelsForIssueR :: Foldable f
+ => Name Owner
+ -> Name Repo
+ -> Id Issue
+ -> f (Name IssueLabel)
+ -> Request 'True (Vector IssueLabel)
+replaceAllLabelsForIssueR user repo iid lbls =
+ Command Put paths (encode $ toList lbls)
+ where
+ paths = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"]
+
+-- | Remove all labels from an issue.
+--
+-- > removeAllLabelsFromIssue (User (user password)) "thoughtbot" "paperclip" (Id 585)
+removeAllLabelsFromIssue :: Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error ())
+removeAllLabelsFromIssue auth user repo iid =
+ executeRequest auth $ removeAllLabelsFromIssueR user repo iid
+
+-- | Remove all labels from an issue.
+-- See
+removeAllLabelsFromIssueR :: Name Owner -> Name Repo -> Id Issue -> Request 'True ()
+removeAllLabelsFromIssueR user repo iid =
+ Command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] mempty
+
+-- | All the labels on a repo's milestone given the milestone ID.
+--
+-- > labelsOnMilestone "thoughtbot" "paperclip" (Id 2)
+labelsOnMilestone :: Name Owner -> Name Repo -> Id Milestone -> IO (Either Error (Vector IssueLabel))
+labelsOnMilestone = labelsOnMilestone' Nothing
+
+-- | All the labels on a repo's milestone given the milestone ID using authentication.
+--
+-- > labelsOnMilestone' (Just (User (user password))) "thoughtbot" "paperclip" (Id 2)
+labelsOnMilestone' :: Maybe Auth -> Name Owner -> Name Repo -> Id Milestone -> IO (Either Error (Vector IssueLabel))
+labelsOnMilestone' auth user repo mid =
+ executeRequestMaybe auth $ labelsOnMilestoneR user repo mid Nothing
+
+-- | Query labels for every issue in a milestone.
+-- See
+labelsOnMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> Maybe Count -> Request k (Vector IssueLabel)
+labelsOnMilestoneR user repo mid =
+ PagedQuery ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid, "labels"] []
diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Endpoints/Issues/Milestones.hs
@@ -0,0 +1,51 @@
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- The milestones API as described on
+-- .
+module GitHub.Endpoints.Issues.Milestones (
+ milestones,
+ milestones',
+ milestonesR,
+ milestone,
+ milestoneR,
+ module GitHub.Data,
+ ) where
+
+import Data.Vector (Vector)
+
+import GitHub.Data
+import GitHub.Request
+
+-- | All milestones in the repo.
+--
+-- > milestones "thoughtbot" "paperclip"
+milestones :: Name Owner -> Name Repo -> IO (Either Error (Vector Milestone))
+milestones = milestones' Nothing
+
+-- | All milestones in the repo, using authentication.
+--
+-- > milestones' (User (user, passwordG) "thoughtbot" "paperclip"
+milestones' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Milestone))
+milestones' auth user repo =
+ executeRequestMaybe auth $ milestonesR user repo Nothing
+
+-- | List milestones for a repository.
+-- See
+milestonesR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Milestone)
+milestonesR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "milestones"] []
+
+-- | Details on a specific milestone, given it's milestone number.
+--
+-- > milestone "thoughtbot" "paperclip" (Id 2)
+milestone :: Name Owner -> Name Repo -> Id Milestone -> IO (Either Error Milestone)
+milestone user repo mid =
+ executeRequest' $ milestoneR user repo mid
+
+-- | Query a single milestone.
+-- See
+milestoneR :: Name Owner -> Name Repo -> Id Milestone -> Request k Milestone
+milestoneR user repo mid =
+ Query ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid] []
diff --git a/src/GitHub/Endpoints/Organizations.hs b/src/GitHub/Endpoints/Organizations.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Endpoints/Organizations.hs
@@ -0,0 +1,54 @@
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- The orgs API as described on .
+module GitHub.Endpoints.Organizations (
+ publicOrganizationsFor,
+ publicOrganizationsFor',
+ publicOrganizationsForR,
+ publicOrganization,
+ publicOrganization',
+ publicOrganizationR,
+ module GitHub.Data,
+ ) where
+
+import Data.Vector (Vector)
+import GitHub.Data
+import GitHub.Request
+
+-- | The public organizations for a user, given the user's login, with authorization
+--
+-- > publicOrganizationsFor' (Just ("github-username", "github-password")) "mike-burns"
+publicOrganizationsFor' :: Maybe Auth -> Name User -> IO (Either Error (Vector SimpleOrganization))
+publicOrganizationsFor' auth org =
+ executeRequestMaybe auth $ publicOrganizationsForR org Nothing
+
+-- | List user organizations. The public organizations for a user, given the user's login.
+--
+-- > publicOrganizationsFor "mike-burns"
+publicOrganizationsFor :: Name User -> IO (Either Error (Vector SimpleOrganization))
+publicOrganizationsFor = publicOrganizationsFor' Nothing
+
+-- | List user organizations.
+-- See
+publicOrganizationsForR :: Name User -> Maybe Count -> Request k (Vector SimpleOrganization)
+publicOrganizationsForR user = PagedQuery ["users", toPathPart user, "orgs"] []
+
+-- | Details on a public organization. Takes the organization's login.
+--
+-- > publicOrganization' (Just ("github-username", "github-password")) "thoughtbot"
+publicOrganization' :: Maybe Auth -> Name Organization -> IO (Either Error Organization)
+publicOrganization' auth = executeRequestMaybe auth . publicOrganizationR
+
+-- | Query an organization. Details on a public organization. Takes the organization's login.
+--
+-- > publicOrganization "thoughtbot"
+publicOrganization :: Name Organization -> IO (Either Error Organization)
+publicOrganization = publicOrganization' Nothing
+
+-- | Query an organization.
+-- See
+publicOrganizationR :: Name Organization -> Request k Organization
+publicOrganizationR reqOrganizationName = Query ["orgs", toPathPart reqOrganizationName] []
diff --git a/src/GitHub/Endpoints/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Endpoints/Organizations/Members.hs
@@ -0,0 +1,39 @@
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- The organization members API as described on
+-- .
+module GitHub.Endpoints.Organizations.Members (
+ membersOf,
+ membersOf',
+ membersOfR,
+ module GitHub.Data,
+ ) where
+
+import Data.Vector (Vector)
+
+import GitHub.Data
+import GitHub.Request
+
+-- | All the users who are members of the specified organization,
+-- | with or without authentication.
+--
+-- > membersOf' (Just $ OAuth "token") "thoughtbot"
+membersOf' :: Maybe Auth -> Name Organization -> IO (Either Error (Vector SimpleUser))
+membersOf' auth org =
+ executeRequestMaybe auth $ membersOfR org Nothing
+
+-- | All the users who are members of the specified organization,
+-- | without authentication.
+--
+-- > membersOf "thoughtbot"
+membersOf :: Name Organization -> IO (Either Error (Vector SimpleUser))
+membersOf = membersOf' Nothing
+
+-- | All the users who are members of the specified organization.
+--
+-- See
+membersOfR :: Name Organization -> Maybe Count -> Request k (Vector SimpleUser)
+membersOfR organization = PagedQuery ["orgs", toPathPart organization, "members"] []
diff --git a/src/GitHub/Endpoints/Organizations/Teams.hs b/src/GitHub/Endpoints/Organizations/Teams.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Endpoints/Organizations/Teams.hs
@@ -0,0 +1,183 @@
+{-# LANGUAGE DataKinds #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- The Owner teams API as described on
+-- .
+module GitHub.Endpoints.Organizations.Teams (
+ teamsOf,
+ teamsOf',
+ teamsOfR,
+ teamInfoFor,
+ teamInfoFor',
+ teamInfoForR,
+ createTeamFor',
+ createTeamForR,
+ editTeam',
+ editTeamR,
+ deleteTeam',
+ deleteTeamR,
+ teamMembershipInfoFor,
+ teamMembershipInfoFor',
+ teamMembershipInfoForR,
+ addTeamMembershipFor',
+ addTeamMembershipForR,
+ deleteTeamMembershipFor',
+ deleteTeamMembershipForR,
+ listTeamsCurrent',
+ listTeamsCurrentR,
+ module GitHub.Data,
+ ) where
+
+import Prelude ()
+import Prelude.Compat
+
+import Data.Aeson.Compat (encode)
+import Data.Vector (Vector)
+
+import GitHub.Data
+import GitHub.Request
+
+-- | List teams. List the teams of an Owner.
+-- When authenticated, lists private teams visible to the authenticated user.
+-- When unauthenticated, lists only public teams for an Owner.
+--
+-- > teamsOf' (Just $ OAuth "token") "thoughtbot"
+teamsOf' :: Maybe Auth -> Name Organization -> IO (Either Error (Vector SimpleTeam))
+teamsOf' auth org =
+ executeRequestMaybe auth $ teamsOfR org Nothing
+
+-- | List the public teams of an Owner.
+--
+-- > teamsOf "thoughtbot"
+teamsOf :: Name Organization -> IO (Either Error (Vector SimpleTeam))
+teamsOf = teamsOf' Nothing
+
+-- | List teams.
+-- See
+teamsOfR :: Name Organization -> Maybe Count -> Request k (Vector SimpleTeam)
+teamsOfR org = PagedQuery ["orgs", toPathPart org, "teams"] []
+
+-- | The information for a single team, by team id.
+-- | With authentication
+--
+-- > teamInfoFor' (Just $ OAuth "token") 1010101
+teamInfoFor' :: Maybe Auth -> Id Team -> IO (Either Error Team)
+teamInfoFor' auth tid =
+ executeRequestMaybe auth $ teamInfoForR tid
+
+-- | The information for a single team, by team id.
+--
+-- > teamInfoFor' (Just $ OAuth "token") 1010101
+teamInfoFor :: Id Team -> IO (Either Error Team)
+teamInfoFor = teamInfoFor' Nothing
+
+-- | Query team.
+-- See
+teamInfoForR :: Id Team -> Request k Team
+teamInfoForR tid =
+ Query ["teams", toPathPart tid] []
+
+-- | Create a team under an Owner
+--
+-- > createTeamFor' (OAuth "token") "Owner" (CreateTeam "newteamname" "some description" [] PermssionPull)
+createTeamFor' :: Auth
+ -> Name Organization
+ -> CreateTeam
+ -> IO (Either Error Team)
+createTeamFor' auth org cteam =
+ executeRequest auth $ createTeamForR org cteam
+
+-- | Create team.
+-- See
+createTeamForR :: Name Organization -> CreateTeam -> Request 'True Team
+createTeamForR org cteam =
+ Command Post ["orgs", toPathPart org, "teams"] (encode cteam)
+
+-- | Edit a team, by id.
+--
+-- > editTeamFor'
+editTeam' :: Auth
+ -> Id Team
+ -> EditTeam
+ -> IO (Either Error Team)
+editTeam' auth tid eteam =
+ executeRequest auth $ editTeamR tid eteam
+
+-- | Edit team.
+-- See
+editTeamR :: Id Team -> EditTeam -> Request 'True Team
+editTeamR tid eteam =
+ Command Patch ["teams", toPathPart tid] (encode eteam)
+
+-- | Delete a team, by id.
+--
+-- > deleteTeam' (OAuth "token") 1010101
+deleteTeam' :: Auth -> Id Team -> IO (Either Error ())
+deleteTeam' auth tid =
+ executeRequest auth $ deleteTeamR tid
+
+-- | Delete team.
+-- See
+deleteTeamR :: Id Team -> Request 'True ()
+deleteTeamR tid =
+ Command Delete ["teams", toPathPart tid] mempty
+
+-- | Retrieve team mebership information for a user.
+-- | With authentication
+--
+-- > teamMembershipInfoFor' (Just $ OAuth "token") 1010101 "mburns"
+teamMembershipInfoFor' :: Maybe Auth -> Id Team -> Name Owner -> IO (Either Error TeamMembership)
+teamMembershipInfoFor' auth tid user =
+ executeRequestMaybe auth $ teamMembershipInfoForR tid user
+
+-- | Query team membership.
+-- See Name Owner -> Request k TeamMembership
+teamMembershipInfoForR tid user =
+ Query ["teams", toPathPart tid, "memberships", toPathPart user] []
+
+-- | Retrieve team mebership information for a user.
+--
+-- > teamMembershipInfoFor 1010101 "mburns"
+teamMembershipInfoFor :: Id Team -> Name Owner -> IO (Either Error TeamMembership)
+teamMembershipInfoFor = teamMembershipInfoFor' Nothing
+
+-- | Add (or invite) a member to a team.
+--
+-- > addTeamMembershipFor' (OAuth "token") 1010101 "mburns" RoleMember
+addTeamMembershipFor' :: Auth -> Id Team -> Name Owner -> Role-> IO (Either Error TeamMembership)
+addTeamMembershipFor' auth tid user role =
+ executeRequest auth $ addTeamMembershipForR tid user role
+
+-- | Add team membership.
+-- See
+addTeamMembershipForR :: Id Team -> Name Owner -> Role -> Request 'True TeamMembership
+addTeamMembershipForR tid user role =
+ Command Put ["teams", toPathPart tid, "memberships", toPathPart user] (encode $ CreateTeamMembership role)
+
+-- | Delete a member of a team.
+--
+-- > deleteTeamMembershipFor' (OAuth "token") 1010101 "mburns"
+deleteTeamMembershipFor' :: Auth -> Id Team -> Name Owner -> IO (Either Error ())
+deleteTeamMembershipFor' auth tid user =
+ executeRequest auth $ deleteTeamMembershipForR tid user
+
+-- | Remove team membership.
+-- See
+deleteTeamMembershipForR :: Id Team -> Name Owner -> Request 'True ()
+deleteTeamMembershipForR tid user =
+ Command Delete ["teams", toPathPart tid, "memberships", toPathPart user] mempty
+
+-- | List teams for current authenticated user
+--
+-- > listTeamsCurrent' (OAuth "token")
+listTeamsCurrent' :: Auth -> IO (Either Error (Vector Team))
+listTeamsCurrent' auth = executeRequest auth $ listTeamsCurrentR Nothing
+
+-- | List user teams.
+-- See
+listTeamsCurrentR :: Maybe Count -> Request 'True (Vector Team)
+listTeamsCurrentR = PagedQuery ["user", "teams"] []
diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Endpoints/PullRequests.hs
@@ -0,0 +1,203 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- The pull requests API as documented at
+-- .
+module GitHub.Endpoints.PullRequests (
+ pullRequestsFor'',
+ pullRequestsFor',
+ pullRequestsFor,
+ pullRequestsForR,
+ pullRequest',
+ pullRequest,
+ pullRequestR,
+ createPullRequest,
+ createPullRequestR,
+ updatePullRequest,
+ updatePullRequestR,
+ pullRequestCommits',
+ pullRequestCommitsIO,
+ pullRequestCommitsR,
+ pullRequestFiles',
+ pullRequestFiles,
+ pullRequestFilesR,
+ isPullRequestMerged,
+ isPullRequestMergedR,
+ mergePullRequest,
+ mergePullRequestR,
+ module GitHub.Data
+ ) where
+
+import GitHub.Data
+import GitHub.Request
+
+import Data.Aeson.Compat (Value, encode, object, (.=))
+import Data.Vector (Vector)
+
+import qualified Data.ByteString.Char8 as BS8
+
+-- | All pull requests for the repo, by owner, repo name, and pull request state.
+-- | With authentification
+--
+-- > pullRequestsFor' (Just ("github-username", "github-password")) (Just "open") "rails" "rails"
+--
+-- State can be one of @all@, @open@, or @closed@. Default is @open@.
+--
+pullRequestsFor'' :: Maybe Auth -> Maybe String -> Name Owner -> Name Repo -> IO (Either Error (Vector SimplePullRequest))
+pullRequestsFor'' auth state user repo =
+ executeRequestMaybe auth $ pullRequestsForR user repo state Nothing
+
+-- | All pull requests for the repo, by owner and repo name.
+-- | With authentification
+--
+-- > pullRequestsFor' (Just ("github-username", "github-password")) "rails" "rails"
+pullRequestsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimplePullRequest))
+pullRequestsFor' auth = pullRequestsFor'' auth Nothing
+
+-- | All pull requests for the repo, by owner and repo name.
+--
+-- > pullRequestsFor "rails" "rails"
+pullRequestsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector SimplePullRequest))
+pullRequestsFor = pullRequestsFor'' Nothing Nothing
+
+-- | List pull requests.
+-- See
+pullRequestsForR :: Name Owner -> Name Repo
+ -> Maybe String -- ^ State
+ -> Maybe Count
+ -> Request k (Vector SimplePullRequest)
+pullRequestsForR user repo state =
+ PagedQuery ["repos", toPathPart user, toPathPart repo, "pulls"] qs
+ where
+ qs = maybe [] (\s -> [("state", Just . BS8.pack $ s)]) state
+
+-- | A detailed pull request, which has much more information. This takes the
+-- repo owner and name along with the number assigned to the pull request.
+-- | With authentification
+--
+-- > pullRequest' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 562
+pullRequest' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error PullRequest)
+pullRequest' auth user repo prid =
+ executeRequestMaybe auth $ pullRequestR user repo prid
+
+-- | A detailed pull request, which has much more information. This takes the
+-- repo owner and name along with the number assigned to the pull request.
+--
+-- > pullRequest "thoughtbot" "paperclip" 562
+pullRequest :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error PullRequest)
+pullRequest = pullRequest' Nothing
+
+-- | Query a single pull request.
+-- See
+pullRequestR :: Name Owner -> Name Repo -> Id PullRequest -> Request k PullRequest
+pullRequestR user repo prid =
+ Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] []
+
+createPullRequest :: Auth
+ -> Name Owner
+ -> Name Repo
+ -> CreatePullRequest
+ -> IO (Either Error PullRequest)
+createPullRequest auth user repo cpr =
+ executeRequest auth $ createPullRequestR user repo cpr
+
+-- | Create a pull request.
+-- See
+createPullRequestR :: Name Owner
+ -> Name Repo
+ -> CreatePullRequest
+ -> Request 'True PullRequest
+createPullRequestR user repo cpr =
+ Command Post ["repos", toPathPart user, toPathPart repo, "pulls"] (encode cpr)
+
+-- | Update a pull request
+updatePullRequest :: Auth -> Name Owner -> Name Repo -> Id PullRequest -> EditPullRequest -> IO (Either Error PullRequest)
+updatePullRequest auth user repo prid epr =
+ executeRequest auth $ updatePullRequestR user repo prid epr
+
+-- | Update a pull request.
+-- See
+updatePullRequestR :: Name Owner
+ -> Name Repo
+ -> Id PullRequest
+ -> EditPullRequest
+ -> Request 'True PullRequest
+updatePullRequestR user repo prid epr =
+ Command Patch ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] (encode epr)
+
+-- | All the commits on a pull request, given the repo owner, repo name, and
+-- the number of the pull request.
+-- | With authentification
+--
+-- > pullRequestCommits' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688
+pullRequestCommits' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Commit))
+pullRequestCommits' auth user repo prid =
+ executeRequestMaybe auth $ pullRequestCommitsR user repo prid Nothing
+
+-- | All the commits on a pull request, given the repo owner, repo name, and
+-- the number of the pull request.
+--
+-- > pullRequestCommits "thoughtbot" "paperclip" 688
+pullRequestCommitsIO :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Commit))
+pullRequestCommitsIO = pullRequestCommits' Nothing
+
+-- | List commits on a pull request.
+-- See
+pullRequestCommitsR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe Count -> Request k (Vector Commit)
+pullRequestCommitsR user repo prid =
+ PagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "commits"] []
+
+-- | The individual files that a pull request patches. Takes the repo owner and
+-- name, plus the number assigned to the pull request.
+-- | With authentification
+--
+-- > pullRequestFiles' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688
+pullRequestFiles' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector File))
+pullRequestFiles' auth user repo prid =
+ executeRequestMaybe auth $ pullRequestFilesR user repo prid Nothing
+
+-- | The individual files that a pull request patches. Takes the repo owner and
+-- name, plus the number assigned to the pull request.
+--
+-- > pullRequestFiles "thoughtbot" "paperclip" 688
+pullRequestFiles :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector File))
+pullRequestFiles = pullRequestFiles' Nothing
+
+-- | List pull requests files.
+-- See
+pullRequestFilesR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe Count -> Request k (Vector File)
+pullRequestFilesR user repo prid =
+ PagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "files"] []
+
+-- | Check if pull request has been merged.
+isPullRequestMerged :: Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error Bool)
+isPullRequestMerged auth user repo prid =
+ executeRequest auth $ isPullRequestMergedR user repo prid
+
+-- | Query if a pull request has been merged.
+-- See
+isPullRequestMergedR :: Name Owner -> Name Repo -> Id PullRequest -> Request k Bool
+isPullRequestMergedR user repo prid = StatusQuery StatusOnlyOk $
+ Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] []
+
+-- | Merge a pull request.
+mergePullRequest :: Auth -> Name Owner -> Name Repo -> Id PullRequest -> Maybe String -> IO (Either Error MergeResult)
+mergePullRequest auth user repo prid commitMessage =
+ executeRequest auth $ mergePullRequestR user repo prid commitMessage
+
+-- | Merge a pull request (Merge Button).
+-- https://developer.github.com/v3/pulls/#merge-a-pull-request-merge-button
+mergePullRequestR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe String -> Request 'True MergeResult
+mergePullRequestR user repo prid commitMessage = StatusQuery StatusMerge $
+ Command Put paths (encode $ buildCommitMessageMap commitMessage)
+ where
+ paths = ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"]
+
+ buildCommitMessageMap :: Maybe String -> Value
+ buildCommitMessageMap (Just msg) = object ["commit_message" .= msg ]
+ buildCommitMessageMap Nothing = object []
+
diff --git a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs b/src/GitHub/Endpoints/PullRequests/ReviewComments.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Endpoints/PullRequests/ReviewComments.hs
@@ -0,0 +1,44 @@
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- The pull request review comments API as described at
+-- .
+module GitHub.Endpoints.PullRequests.ReviewComments (
+ pullRequestReviewCommentsIO,
+ pullRequestReviewCommentsR,
+ pullRequestReviewComment,
+ pullRequestReviewCommentR,
+ module GitHub.Data,
+ ) where
+
+import Data.Vector (Vector)
+import GitHub.Data
+import GitHub.Request
+
+-- | All the comments on a pull request with the given ID.
+--
+-- > pullRequestReviewComments "thoughtbot" "factory_girl" (Id 256)
+pullRequestReviewCommentsIO :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Comment))
+pullRequestReviewCommentsIO user repo prid =
+ executeRequest' $ pullRequestReviewCommentsR user repo prid Nothing
+
+-- | List comments on a pull request.
+-- See
+pullRequestReviewCommentsR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe Count -> Request k (Vector Comment)
+pullRequestReviewCommentsR user repo prid =
+ PagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "comments"] []
+
+-- | One comment on a pull request, by the comment's ID.
+--
+-- > pullRequestReviewComment "thoughtbot" "factory_girl" (Id 301819)
+pullRequestReviewComment :: Name Owner -> Name Repo -> Id Comment -> IO (Either Error Comment)
+pullRequestReviewComment user repo cid =
+ executeRequest' $ pullRequestReviewCommentR user repo cid
+
+-- | Query a single comment.
+-- See
+pullRequestReviewCommentR :: Name Owner -> Name Repo -> Id Comment -> Request k Comment
+pullRequestReviewCommentR user repo cid =
+ Query ["repos", toPathPart user, toPathPart repo, "pulls", "comments", toPathPart cid] []
diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Endpoints/Repos.hs
@@ -0,0 +1,364 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- The Github Repos API, as documented at
+--
+module GitHub.Endpoints.Repos (
+ -- * Querying repositories
+ currentUserRepos,
+ currentUserReposR,
+ userRepos,
+ userRepos',
+ userReposR,
+ organizationRepos,
+ organizationRepos',
+ organizationReposR,
+ repository,
+ repository',
+ repositoryR,
+ contributors,
+ contributors',
+ contributorsR,
+ contributorsWithAnonymous,
+ contributorsWithAnonymous',
+ languagesFor,
+ languagesFor',
+ languagesForR,
+ tagsFor,
+ tagsFor',
+ tagsForR,
+ branchesFor,
+ branchesFor',
+ branchesForR,
+ contentsFor,
+ contentsFor',
+ readmeFor,
+ readmeFor',
+
+ -- ** Create
+ createRepo',
+ createRepoR,
+ createOrganizationRepo',
+ createOrganizationRepoR,
+
+ -- ** Edit
+ editRepo,
+ editRepoR,
+
+ -- ** Delete
+ deleteRepo,
+ deleteRepoR,
+
+ -- * Data
+ module GitHub.Data,
+ ) where
+
+import Prelude ()
+import Prelude.Compat
+
+import Control.Applicative ((<|>))
+import Data.Aeson.Compat (encode)
+import Data.Vector (Vector)
+
+import GitHub.Data
+import GitHub.Request
+
+import qualified Data.ByteString.Char8 as BS8
+
+repoPublicityQueryString :: RepoPublicity -> QueryString
+repoPublicityQueryString RepoPublicityAll = [("type", Just "all")]
+repoPublicityQueryString RepoPublicityOwner = [("type", Just "owner")]
+repoPublicityQueryString RepoPublicityMember = [("type", Just "member")]
+repoPublicityQueryString RepoPublicityPublic = [("type", Just "public")]
+repoPublicityQueryString RepoPublicityPrivate = [("type", Just "private")]
+
+-- | List your repositories.
+currentUserRepos :: Auth -> RepoPublicity -> IO (Either Error (Vector Repo))
+currentUserRepos auth publicity =
+ executeRequest auth $ currentUserReposR publicity Nothing
+
+-- | List your repositories.
+-- See
+currentUserReposR :: RepoPublicity -> Maybe Count -> Request k(Vector Repo)
+currentUserReposR publicity =
+ PagedQuery ["user", "repos"] qs
+ where
+ qs = repoPublicityQueryString publicity
+
+-- | The repos for a user, by their login. Can be restricted to just repos they
+-- own, are a member of, or publicize. Private repos will return empty list.
+--
+-- > userRepos "mike-burns" All
+userRepos :: Name Owner -> RepoPublicity -> IO (Either Error (Vector Repo))
+userRepos = userRepos' Nothing
+
+-- | The repos for a user, by their login.
+-- With authentication.
+--
+-- > userRepos' (Just (BasicAuth (user, password))) "mike-burns" All
+userRepos' :: Maybe Auth -> Name Owner -> RepoPublicity -> IO (Either Error (Vector Repo))
+userRepos' auth user publicity =
+ executeRequestMaybe auth $ userReposR user publicity Nothing
+
+-- | List user repositories.
+-- See
+userReposR :: Name Owner -> RepoPublicity -> Maybe Count -> Request k(Vector Repo)
+userReposR user publicity =
+ PagedQuery ["users", toPathPart user, "repos"] qs
+ where
+ qs = repoPublicityQueryString publicity
+
+-- | The repos for an organization, by the organization name.
+--
+-- > organizationRepos "thoughtbot"
+organizationRepos :: Name Organization -> IO (Either Error (Vector Repo))
+organizationRepos org = organizationRepos' Nothing org RepoPublicityAll
+
+-- | The repos for an organization, by the organization name.
+-- With authentication.
+--
+-- > organizationRepos (Just (BasicAuth (user, password))) "thoughtbot" All
+organizationRepos' :: Maybe Auth -> Name Organization -> RepoPublicity -> IO (Either Error (Vector Repo))
+organizationRepos' auth org publicity =
+ executeRequestMaybe auth $ organizationReposR org publicity Nothing
+
+-- | List organization repositories.
+-- See
+organizationReposR :: Name Organization -> RepoPublicity -> Maybe Count -> Request k (Vector Repo)
+organizationReposR org publicity =
+ PagedQuery ["orgs", toPathPart org, "repos"] qs
+ where
+ qs = repoPublicityQueryString publicity
+
+-- | Details on a specific repo, given the owner and repo name.
+--
+-- > userRepo "mike-burns" "github"
+repository :: Name Owner -> Name Repo -> IO (Either Error Repo)
+repository = repository' Nothing
+
+-- | Details on a specific repo, given the owner and repo name.
+-- With authentication.
+--
+-- > userRepo' (Just (BasicAuth (user, password))) "mike-burns" "github"
+repository' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Repo)
+repository' auth user repo =
+ executeRequestMaybe auth $ repositoryR user repo
+
+-- | Query single repository.
+-- See
+repositoryR :: Name Owner -> Name Repo -> Request k Repo
+repositoryR user repo =
+ Query ["repos", toPathPart user, toPathPart repo] []
+
+-- | Create a new repository.
+--
+-- > createRepo' (BasicAuth (user, password)) (newRepo "some_repo") {newRepoHasIssues = Just False}
+createRepo' :: Auth -> NewRepo -> IO (Either Error Repo)
+createRepo' auth nrepo =
+ executeRequest auth $ createRepoR nrepo
+
+-- | Create a new repository.
+-- See
+createRepoR :: NewRepo -> Request 'True Repo
+createRepoR nrepo =
+ Command Post ["user", "repos"] (encode nrepo)
+
+-- | Create a new repository for an organization.
+--
+-- > createOrganizationRepo (BasicAuth (user, password)) "thoughtbot" (newRepo "some_repo") {newRepoHasIssues = Just False}
+createOrganizationRepo' :: Auth -> Name Organization -> NewRepo -> IO (Either Error Repo)
+createOrganizationRepo' auth org nrepo =
+ executeRequest auth $ createOrganizationRepoR org nrepo
+
+-- | Create a new repository for an organization.
+-- See
+createOrganizationRepoR :: Name Organization -> NewRepo -> Request 'True Repo
+createOrganizationRepoR org nrepo =
+ Command Post ["orgs", toPathPart org, "repos"] (encode nrepo)
+
+-- | Edit an existing repository.
+--
+-- > editRepo (BasicAuth (user, password)) "some_user" "some_repo" def {editDescription = Just "some description"}
+editRepo :: Auth
+ -> Name Owner -- ^ owner
+ -> Name Repo -- ^ repository name
+ -> EditRepo
+ -> IO (Either Error Repo)
+editRepo auth user repo body =
+ executeRequest auth $ editRepoR user repo body
+
+
+-- | Edit an existing repository.
+-- See
+editRepoR :: Name Owner -> Name Repo -> EditRepo -> Request 'True Repo
+editRepoR user repo body =
+ Command Patch ["repos", toPathPart user, toPathPart repo] (encode b)
+ where
+ -- if no name is given, use curent name
+ b = body {editName = editName body <|> Just repo}
+
+-- | The contributors to a repo, given the owner and repo name.
+--
+-- > contributors "thoughtbot" "paperclip"
+contributors :: Name Owner -> Name Repo -> IO (Either Error (Vector Contributor))
+contributors = contributors' Nothing
+
+-- | The contributors to a repo, given the owner and repo name.
+-- With authentication.
+--
+-- > contributors' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip"
+contributors' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Contributor))
+contributors' auth user repo =
+ executeRequestMaybe auth $ contributorsR user repo False Nothing
+
+-- | List contributors.
+-- See
+contributorsR :: Name Owner
+ -> Name Repo
+ -> Bool -- ^ Include anonymous
+ -> Maybe Count
+ -> Request k (Vector Contributor)
+contributorsR user repo anon =
+ PagedQuery ["repos", toPathPart user, toPathPart repo, "contributors"] qs
+ where
+ qs | anon = [("anon", Just "true")]
+ | otherwise = []
+
+-- | The contributors to a repo, including anonymous contributors (such as
+-- deleted users or git commits with unknown email addresses), given the owner
+-- and repo name.
+--
+-- > contributorsWithAnonymous "thoughtbot" "paperclip"
+contributorsWithAnonymous :: Name Owner -> Name Repo -> IO (Either Error (Vector Contributor))
+contributorsWithAnonymous = contributorsWithAnonymous' Nothing
+
+-- | The contributors to a repo, including anonymous contributors (such as
+-- deleted users or git commits with unknown email addresses), given the owner
+-- and repo name.
+-- With authentication.
+--
+-- > contributorsWithAnonymous' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip"
+contributorsWithAnonymous' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Contributor))
+contributorsWithAnonymous' auth user repo =
+ executeRequestMaybe auth $ contributorsR user repo True Nothing
+
+-- | The programming languages used in a repo along with the number of
+-- characters written in that language. Takes the repo owner and name.
+--
+-- > languagesFor "mike-burns" "ohlaunch"
+languagesFor :: Name Owner -> Name Repo -> IO (Either Error Languages)
+languagesFor = languagesFor' Nothing
+
+-- | The programming languages used in a repo along with the number of
+-- characters written in that language. Takes the repo owner and name.
+-- With authentication.
+--
+-- > languagesFor' (Just (BasicAuth (user, password))) "mike-burns" "ohlaunch"
+languagesFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Languages)
+languagesFor' auth user repo =
+ executeRequestMaybe auth $ languagesForR user repo
+
+-- | List languages.
+-- See
+languagesForR :: Name Owner -> Name Repo -> Request k Languages
+languagesForR user repo =
+ Query ["repos", toPathPart user, toPathPart repo, "languages"] []
+
+-- | The git tags on a repo, given the repo owner and name.
+--
+-- > tagsFor "thoughtbot" "paperclip"
+tagsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Tag))
+tagsFor = tagsFor' Nothing
+
+-- | The git tags on a repo, given the repo owner and name.
+-- With authentication.
+--
+-- > tagsFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip"
+tagsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Tag))
+tagsFor' auth user repo =
+ executeRequestMaybe auth $ tagsForR user repo Nothing
+
+-- | List tags.
+-- See
+tagsForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Tag)
+tagsForR user repo =
+ PagedQuery ["repos", toPathPart user, toPathPart repo, "tags"] []
+
+-- | The git branches on a repo, given the repo owner and name.
+--
+-- > branchesFor "thoughtbot" "paperclip"
+branchesFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Branch))
+branchesFor = branchesFor' Nothing
+
+-- | The git branches on a repo, given the repo owner and name.
+-- With authentication.
+--
+-- > branchesFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip"
+branchesFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Branch))
+branchesFor' auth user repo =
+ executeRequestMaybe auth $ branchesForR user repo Nothing
+
+-- | List branches.
+-- See
+branchesForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Branch)
+branchesForR user repo =
+ PagedQuery ["repos", toPathPart user, toPathPart repo, "branches"] []
+
+-- | The contents of a file or directory in a repo, given the repo owner, name, and path to the file
+--
+-- > contentsFor "thoughtbot" "paperclip" "README.md"
+contentsFor :: Name Owner -> Name Repo -> String -> Maybe String -> IO (Either Error Content)
+contentsFor = contentsFor' Nothing
+
+-- | The contents of a file or directory in a repo, given the repo owner, name, and path to the file
+-- With Authentication
+--
+-- > contentsFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" "README.md" Nothing
+contentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> String -> Maybe String -> IO (Either Error Content)
+contentsFor' auth user repo path ref =
+ executeRequestMaybe auth $ contentsForR user repo path ref
+
+contentsForR :: Name Owner
+ -> Name Repo
+ -> String -- ^ file or directory
+ -> Maybe String -- ^ Git commit
+ -> Request k Content
+contentsForR user repo path ref =
+ Query ["repos", toPathPart user, toPathPart repo, "contents", path] qs
+ where
+ qs = maybe [] (\r -> [("ref", Just . BS8.pack $ r)]) ref
+
+-- | The contents of a README file in a repo, given the repo owner and name
+--
+-- > readmeFor "thoughtbot" "paperclip"
+readmeFor :: Name Owner -> Name Repo -> IO (Either Error Content)
+readmeFor = readmeFor' Nothing
+
+-- | The contents of a README file in a repo, given the repo owner and name
+-- With Authentication
+--
+-- > readmeFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip"
+readmeFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Content)
+readmeFor' auth user repo =
+ executeRequestMaybe auth $ readmeForR user repo
+
+readmeForR :: Name Owner -> Name Repo -> Request k Content
+readmeForR user repo =
+ Query ["repos", toPathPart user, toPathPart repo, "readme"] []
+
+-- | Delete an existing repository.
+--
+-- > deleteRepo (BasicAuth (user, password)) "thoughtbot" "some_repo"
+deleteRepo :: Auth -> Name Owner -> Name Repo -> IO (Either Error ())
+deleteRepo auth user repo =
+ executeRequest auth $ deleteRepoR user repo
+
+deleteRepoR :: Name Owner -> Name Repo -> Request 'True ()
+deleteRepoR user repo =
+ Command Delete ["repos", toPathPart user, toPathPart repo] mempty
diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Endpoints/Repos/Collaborators.hs
@@ -0,0 +1,59 @@
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- The repo collaborators API as described on
+-- .
+module GitHub.Endpoints.Repos.Collaborators (
+ collaboratorsOn,
+ collaboratorsOn',
+ collaboratorsOnR,
+ isCollaboratorOn,
+ isCollaboratorOnR,
+ module GitHub.Data,
+ ) where
+
+import Data.Vector (Vector)
+import GitHub.Data
+import GitHub.Request
+
+-- | All the users who have collaborated on a repo.
+--
+-- > collaboratorsOn "thoughtbot" "paperclip"
+collaboratorsOn :: Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser))
+collaboratorsOn = collaboratorsOn' Nothing
+
+-- | All the users who have collaborated on a repo.
+-- With authentication.
+collaboratorsOn' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser))
+collaboratorsOn' auth user repo =
+ executeRequestMaybe auth $ collaboratorsOnR user repo Nothing
+
+-- | List collaborators.
+-- See
+collaboratorsOnR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector SimpleUser)
+collaboratorsOnR user repo =
+ PagedQuery ["repos", toPathPart user, toPathPart repo, "collaborators"] []
+
+-- | Whether the user is collaborating on a repo. Takes the user in question,
+-- the user who owns the repo, and the repo name.
+--
+-- > isCollaboratorOn Nothing "mike-burns" "thoughtbot" "paperclip"
+-- > isCollaboratorOn Nothing "johnson" "thoughtbot" "paperclip"
+isCollaboratorOn :: Maybe Auth
+ -> Name Owner -- ^ Repository owner
+ -> Name Repo -- ^ Repository name
+ -> Name User -- ^ Collaborator?
+ -> IO (Either Error Bool)
+isCollaboratorOn auth user repo coll =
+ executeRequestMaybe auth $ isCollaboratorOnR user repo coll
+
+-- | Check if a user is a collaborator.
+-- See
+isCollaboratorOnR :: Name Owner -- ^ Repository owner
+ -> Name Repo -- ^ Repository name
+ -> Name User -- ^ Collaborator?
+ -> Request k Bool
+isCollaboratorOnR user repo coll = StatusQuery StatusOnlyOk $
+ Query ["repos", toPathPart user, toPathPart repo, "collaborators", toPathPart coll] []
diff --git a/src/GitHub/Endpoints/Repos/Comments.hs b/src/GitHub/Endpoints/Repos/Comments.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Endpoints/Repos/Comments.hs
@@ -0,0 +1,83 @@
+{-# LANGUAGE CPP #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- The repo commits API as described on
+-- .
+module GitHub.Endpoints.Repos.Comments (
+ commentsFor,
+ commentsFor',
+ commentsForR,
+ commitCommentsFor,
+ commitCommentsFor',
+ commitCommentsForR,
+ commitCommentFor,
+ commitCommentFor',
+ commitCommentForR,
+ module GitHub.Data,
+ ) where
+
+import Data.Vector (Vector)
+import GitHub.Data
+import GitHub.Request
+
+-- | All the comments on a Github repo.
+--
+-- > commentsFor "thoughtbot" "paperclip"
+commentsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Comment))
+commentsFor = commentsFor' Nothing
+
+-- | All the comments on a Github repo.
+-- With authentication.
+--
+-- > commentsFor "thoughtbot" "paperclip"
+commentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Comment))
+commentsFor' auth user repo =
+ executeRequestMaybe auth $ commentsForR user repo Nothing
+
+-- | List commit comments for a repository.
+-- See
+commentsForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Comment)
+commentsForR user repo =
+ PagedQuery ["repos", toPathPart user, toPathPart repo, "comments"] []
+
+-- | Just the comments on a specific SHA for a given Github repo.
+--
+-- > commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b"
+commitCommentsFor :: Name Owner -> Name Repo -> Name Commit -> IO (Either Error (Vector Comment))
+commitCommentsFor = commitCommentsFor' Nothing
+
+-- | Just the comments on a specific SHA for a given Github repo.
+-- With authentication.
+--
+-- > commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b"
+commitCommentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error (Vector Comment))
+commitCommentsFor' auth user repo sha =
+ executeRequestMaybe auth $ commitCommentsForR user repo sha Nothing
+
+-- | List comments for a single commit.
+-- See
+commitCommentsForR :: Name Owner -> Name Repo -> Name Commit -> Maybe Count -> Request k (Vector Comment)
+commitCommentsForR user repo sha =
+ PagedQuery ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "comments"] []
+
+-- | A comment, by its ID, relative to the Github repo.
+--
+-- > commitCommentFor "thoughtbot" "paperclip" "669575"
+commitCommentFor :: Name Owner -> Name Repo -> Id Comment -> IO (Either Error Comment)
+commitCommentFor = commitCommentFor' Nothing
+
+-- | A comment, by its ID, relative to the Github repo.
+--
+-- > commitCommentFor "thoughtbot" "paperclip" "669575"
+commitCommentFor' :: Maybe Auth -> Name Owner -> Name Repo -> Id Comment -> IO (Either Error Comment)
+commitCommentFor' auth user repo cid =
+ executeRequestMaybe auth $ commitCommentForR user repo cid
+
+-- | Query a single commit comment.
+-- See
+commitCommentForR :: Name Owner -> Name Repo -> Id Comment -> Request k Comment
+commitCommentForR user repo cid =
+ Query ["repos", toPathPart user, toPathPart repo, "comments", toPathPart cid] []
diff --git a/src/GitHub/Endpoints/Repos/Commits.hs b/src/GitHub/Endpoints/Repos/Commits.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Endpoints/Repos/Commits.hs
@@ -0,0 +1,121 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- The repo commits API as described on
+-- .
+module GitHub.Endpoints.Repos.Commits (
+ CommitQueryOption(..),
+ commitsFor,
+ commitsFor',
+ commitsForR,
+ commitsWithOptionsFor,
+ commitsWithOptionsFor',
+ commitsWithOptionsForR,
+ commit,
+ commit',
+ commitR,
+ diff,
+ diff',
+ diffR,
+ module GitHub.Data,
+ ) where
+
+import Data.Time.ISO8601 (formatISO8601)
+import Data.Vector (Vector)
+
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as BS8
+import qualified Data.Text.Encoding as TE
+
+import GitHub.Data
+import GitHub.Request
+
+renderCommitQueryOption :: CommitQueryOption -> (BS.ByteString, Maybe BS.ByteString)
+renderCommitQueryOption (CommitQuerySha sha) = ("sha", Just $ TE.encodeUtf8 sha)
+renderCommitQueryOption (CommitQueryPath path) = ("path", Just $ TE.encodeUtf8 path)
+renderCommitQueryOption (CommitQueryAuthor author) = ("author", Just $ TE.encodeUtf8 author)
+renderCommitQueryOption (CommitQuerySince date) = ("since", Just $ BS8.pack $ formatISO8601 date)
+renderCommitQueryOption (CommitQueryUntil date) = ("until", Just $ BS8.pack $ formatISO8601 date)
+
+-- | The commit history for a repo.
+--
+-- > commitsFor "mike-burns" "github"
+commitsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Commit))
+commitsFor = commitsFor' Nothing
+
+-- | The commit history for a repo.
+-- With authentication.
+--
+-- > commitsFor' (Just (BasicAuth (user, password))) "mike-burns" "github"
+commitsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Commit))
+commitsFor' auth user repo =
+ commitsWithOptionsFor' auth user repo []
+
+-- | List commits on a repository.
+-- See
+commitsForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Commit)
+commitsForR user repo limit = commitsWithOptionsForR user repo limit []
+
+commitsWithOptionsFor :: Name Owner -> Name Repo -> [CommitQueryOption] -> IO (Either Error (Vector Commit))
+commitsWithOptionsFor = commitsWithOptionsFor' Nothing
+
+-- | The commit history for a repo, with commits filtered to satisfy a list of
+-- query options.
+-- With authentication.
+--
+-- > commitsWithOptionsFor' (Just (BasicAuth (user, password))) "mike-burns" "github" [CommitQueryAuthor "djeik"]
+commitsWithOptionsFor' :: Maybe Auth -> Name Owner -> Name Repo -> [CommitQueryOption] -> IO (Either Error (Vector Commit))
+commitsWithOptionsFor' auth user repo opts =
+ executeRequestMaybe auth $ commitsWithOptionsForR user repo Nothing opts
+
+-- | List commits on a repository.
+-- See
+commitsWithOptionsForR :: Name Owner -> Name Repo -> Maybe Count -> [CommitQueryOption] -> Request k (Vector Commit)
+commitsWithOptionsForR user repo limit opts =
+ PagedQuery ["repos", toPathPart user, toPathPart repo, "commits"] qs limit
+ where
+ qs = map renderCommitQueryOption opts
+
+
+-- | Details on a specific SHA1 for a repo.
+--
+-- > commit "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81"
+commit :: Name Owner -> Name Repo -> Name Commit -> IO (Either Error Commit)
+commit = commit' Nothing
+
+-- | Details on a specific SHA1 for a repo.
+-- With authentication.
+--
+-- > commit (Just $ BasicAuth (username, password)) "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81"
+commit' :: Maybe Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error Commit)
+commit' auth user repo sha =
+ executeRequestMaybe auth $ commitR user repo sha
+
+-- | Query a single commit.
+-- See
+commitR :: Name Owner -> Name Repo -> Name Commit -> Request k Commit
+commitR user repo sha =
+ Query ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha] []
+
+-- | The diff between two treeishes on a repo.
+--
+-- > diff "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" "HEAD"
+diff :: Name Owner -> Name Repo -> Name Commit -> Name Commit -> IO (Either Error Diff)
+diff = diff' Nothing
+
+-- | The diff between two treeishes on a repo.
+--
+-- > diff "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" "HEAD"
+diff' :: Maybe Auth -> Name Owner -> Name Repo -> Name Commit -> Name Commit -> IO (Either Error Diff)
+diff' auth user repo base headref =
+ executeRequestMaybe auth $ diffR user repo base headref
+
+-- | Compare two commits.
+-- See
+diffR :: Name Owner -> Name Repo -> Name Commit -> Name Commit -> Request k Diff
+diffR user repo base headref =
+ Query ["repos", toPathPart user, toPathPart repo, "compare", toPathPart base ++ "..." ++ toPathPart headref] []
diff --git a/src/GitHub/Endpoints/Repos/Forks.hs b/src/GitHub/Endpoints/Repos/Forks.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Endpoints/Repos/Forks.hs
@@ -0,0 +1,37 @@
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- Hot forking action, as described at
+-- .
+module GitHub.Endpoints.Repos.Forks (
+ forksFor,
+ forksFor',
+ forksForR,
+ module GitHub.Data,
+ ) where
+
+import Data.Vector (Vector)
+import GitHub.Data
+import GitHub.Request
+
+-- | All the repos that are forked off the given repo.
+--
+-- > forksFor "thoughtbot" "paperclip"
+forksFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Repo))
+forksFor = forksFor' Nothing
+
+-- | All the repos that are forked off the given repo.
+-- | With authentication
+--
+-- > forksFor' (Just (User (user, password))) "thoughtbot" "paperclip"
+forksFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Repo))
+forksFor' auth user repo =
+ executeRequestMaybe auth $ forksForR user repo Nothing
+
+-- | List forks.
+-- See
+forksForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Repo)
+forksForR user repo =
+ PagedQuery ["repos", toPathPart user, toPathPart repo, "forks"] []
diff --git a/src/GitHub/Endpoints/Repos/Webhooks.hs b/src/GitHub/Endpoints/Repos/Webhooks.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Endpoints/Repos/Webhooks.hs
@@ -0,0 +1,121 @@
+{-# LANGUAGE DataKinds #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- The webhooks API, as described at
+--
+--
+module GitHub.Endpoints.Repos.Webhooks (
+ -- * Querying repositories
+ webhooksFor',
+ webhooksForR,
+ webhookFor',
+ webhookForR,
+
+ -- ** Create
+ createRepoWebhook',
+ createRepoWebhookR,
+
+ -- ** Edit
+ editRepoWebhook',
+ editRepoWebhookR,
+
+ -- ** Test
+ testPushRepoWebhook',
+ testPushRepoWebhookR,
+ pingRepoWebhook',
+ pingRepoWebhookR,
+
+ -- ** Delete
+ deleteRepoWebhook',
+ deleteRepoWebhookR,
+) where
+
+import Prelude ()
+import Prelude.Compat
+
+import Data.Aeson.Compat (encode)
+import Data.Vector (Vector)
+
+import GitHub.Data
+import GitHub.Request
+
+webhooksFor' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector RepoWebhook))
+webhooksFor' auth user repo =
+ executeRequest auth $ webhooksForR user repo Nothing
+
+-- | List hooks.
+-- See
+webhooksForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector RepoWebhook)
+webhooksForR user repo =
+ PagedQuery ["repos", toPathPart user, toPathPart repo, "hooks"] []
+
+webhookFor' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error RepoWebhook)
+webhookFor' auth user repo hookId =
+ executeRequest auth $ webhookForR user repo hookId
+
+-- | Query single hook.
+-- See
+webhookForR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request k RepoWebhook
+webhookForR user repo hookId =
+ Query ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] []
+
+createRepoWebhook' :: Auth -> Name Owner -> Name Repo -> NewRepoWebhook -> IO (Either Error RepoWebhook)
+createRepoWebhook' auth user repo hook =
+ executeRequest auth $ createRepoWebhookR user repo hook
+
+-- | Create a hook.
+-- See
+createRepoWebhookR :: Name Owner -> Name Repo -> NewRepoWebhook -> Request 'True RepoWebhook
+createRepoWebhookR user repo hook =
+ Command Post ["repos", toPathPart user, toPathPart repo, "hooks"] (encode hook)
+
+editRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> EditRepoWebhook -> IO (Either Error RepoWebhook)
+editRepoWebhook' auth user repo hookId hookEdit =
+ executeRequest auth $ editRepoWebhookR user repo hookId hookEdit
+
+-- | Edit a hook.
+-- See
+editRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> EditRepoWebhook -> Request 'True RepoWebhook
+editRepoWebhookR user repo hookId hookEdit =
+ Command Patch ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] (encode hookEdit)
+
+testPushRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error Bool)
+testPushRepoWebhook' auth user repo hookId =
+ executeRequest auth $ testPushRepoWebhookR user repo hookId
+
+-- | Test a push hook.
+-- See
+testPushRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'True Bool
+testPushRepoWebhookR user repo hookId = StatusQuery StatusOnlyOk $
+ Command Post (createWebhookOpPath user repo hookId $ Just "tests") (encode ())
+
+pingRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error Bool)
+pingRepoWebhook' auth user repo hookId =
+ executeRequest auth $ pingRepoWebhookR user repo hookId
+
+-- | Ping a hook.
+-- See
+pingRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'True Bool
+pingRepoWebhookR user repo hookId = StatusQuery StatusOnlyOk $
+ Command Post (createWebhookOpPath user repo hookId $ Just "pings") (encode ())
+
+deleteRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error ())
+deleteRepoWebhook' auth user repo hookId =
+ executeRequest auth $ deleteRepoWebhookR user repo hookId
+
+-- | Delete a hook.
+-- See
+deleteRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'True ()
+deleteRepoWebhookR user repo hookId =
+ Command Delete (createWebhookOpPath user repo hookId Nothing) mempty
+
+createBaseWebhookPath :: Name Owner -> Name Repo -> Id RepoWebhook -> [String]
+createBaseWebhookPath user repo hookId =
+ ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId]
+
+createWebhookOpPath :: Name Owner -> Name Repo -> Id RepoWebhook -> Maybe String -> [String]
+createWebhookOpPath owner reqName webhookId Nothing = createBaseWebhookPath owner reqName webhookId
+createWebhookOpPath owner reqName webhookId (Just operation) = createBaseWebhookPath owner reqName webhookId ++ [operation]
diff --git a/src/GitHub/Endpoints/Search.hs b/src/GitHub/Endpoints/Search.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Endpoints/Search.hs
@@ -0,0 +1,84 @@
+{-# LANGUAGE OverloadedStrings #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- The Github Search API, as described at
+-- .
+module GitHub.Endpoints.Search(
+ searchRepos',
+ searchRepos,
+ searchReposR,
+ searchCode',
+ searchCode,
+ searchCodeR,
+ searchIssues',
+ searchIssues,
+ searchIssuesR,
+ module GitHub.Data,
+ ) where
+
+import Data.Text (Text)
+
+import qualified Data.Text.Encoding as TE
+
+import GitHub.Data
+import GitHub.Request
+
+-- | Perform a repository search.
+-- With authentication.
+--
+-- > searchRepos' (Just $ BasicAuth "github-username" "github-password') "a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100"
+searchRepos' :: Maybe Auth -> Text -> IO (Either Error (SearchResult Repo))
+searchRepos' auth = executeRequestMaybe auth . searchReposR
+
+-- | Perform a repository search.
+-- Without authentication.
+--
+-- > searchRepos "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100"
+searchRepos :: Text -> IO (Either Error (SearchResult Repo))
+searchRepos = searchRepos' Nothing
+
+-- | Search repositories.
+-- See
+searchReposR :: Text -> Request k (SearchResult Repo)
+searchReposR searchString = Query ["search", "repositories"] [("q", Just $ TE.encodeUtf8 searchString)]
+
+-- | Perform a code search.
+-- With authentication.
+--
+-- > searchCode' (Just $ BasicAuth "github-username" "github-password') "a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100"
+searchCode' :: Maybe Auth -> Text -> IO (Either Error (SearchResult Code))
+searchCode' auth = executeRequestMaybe auth . searchCodeR
+
+-- | Perform a code search.
+-- Without authentication.
+--
+-- > searchCode "q=addClass+in:file+language:js+repo:jquery/jquery"
+searchCode :: Text -> IO (Either Error (SearchResult Code))
+searchCode = searchCode' Nothing
+
+-- | Search code.
+-- See
+searchCodeR :: Text -> Request k (SearchResult Code)
+searchCodeR searchString = Query ["search", "code"] [("q", Just $ TE.encodeUtf8 searchString)]
+
+-- | Perform an issue search.
+-- With authentication.
+--
+-- > searchIssues' (Just $ BasicAuth "github-username" "github-password') "a repo%3Aphadej%2Fgithub&per_page=100"
+searchIssues' :: Maybe Auth -> Text -> IO (Either Error (SearchResult Issue))
+searchIssues' auth = executeRequestMaybe auth . searchIssuesR
+
+-- | Perform an issue search.
+-- Without authentication.
+--
+-- > searchIssues "q=a repo%3Aphadej%2Fgithub&per_page=100"
+searchIssues :: Text -> IO (Either Error (SearchResult Issue))
+searchIssues = searchIssues' Nothing
+
+-- | Search issues.
+-- See
+searchIssuesR :: Text -> Request k (SearchResult Issue)
+searchIssuesR searchString = Query ["search", "issues"] [("q", Just $ TE.encodeUtf8 searchString)]
diff --git a/src/GitHub/Endpoints/Users.hs b/src/GitHub/Endpoints/Users.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Endpoints/Users.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE DataKinds #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- The Github Users API, as described at
+-- .
+module GitHub.Endpoints.Users (
+ userInfoFor,
+ userInfoFor',
+ userInfoForR,
+ ownerInfoForR,
+ userInfoCurrent',
+ userInfoCurrentR,
+ module GitHub.Data,
+ ) where
+
+import GitHub.Data
+import GitHub.Request
+
+-- | The information for a single user, by login name.
+-- With authentification
+--
+-- > userInfoFor' (Just ("github-username", "github-password")) "mike-burns"
+userInfoFor' :: Maybe Auth -> Name User -> IO (Either Error User)
+userInfoFor' auth = executeRequestMaybe auth . userInfoForR
+
+-- | The information for a single user, by login name.
+--
+-- > userInfoFor "mike-burns"
+userInfoFor :: Name User -> IO (Either Error User)
+userInfoFor = executeRequest' . userInfoForR
+
+-- | Query a single user.
+-- See
+userInfoForR :: Name User -> Request k User
+userInfoForR user = Query ["users", toPathPart user] []
+
+-- | Query a single user or an organization.
+-- See
+ownerInfoForR :: Name Owner -> Request k Owner
+ownerInfoForR owner = Query ["users", toPathPart owner] []
+
+-- | Retrieve information about the user associated with the supplied authentication.
+--
+-- > userInfoCurrent' (OAuth "...")
+userInfoCurrent' :: Auth -> IO (Either Error User)
+userInfoCurrent' auth =
+ executeRequest auth $ userInfoCurrentR
+
+-- | Query the authenticated user.
+-- See
+userInfoCurrentR :: Request 'True User
+userInfoCurrentR = Query ["user"] []
diff --git a/src/GitHub/Endpoints/Users/Followers.hs b/src/GitHub/Endpoints/Users/Followers.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Endpoints/Users/Followers.hs
@@ -0,0 +1,43 @@
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- The user followers API as described on
+-- .
+module GitHub.Endpoints.Users.Followers (
+ usersFollowing,
+ usersFollowedBy,
+ usersFollowingR,
+ usersFollowedByR,
+ module GitHub.Data,
+ ) where
+
+import Data.Vector (Vector)
+
+import GitHub.Data
+import GitHub.Request
+
+-- | All the users following the given user.
+--
+-- > usersFollowing "mike-burns"
+usersFollowing :: Name User -> IO (Either Error (Vector SimpleUser))
+usersFollowing user =
+ executeRequest' $ usersFollowingR user Nothing
+
+-- | List followers of a user.
+-- See
+usersFollowingR :: Name User -> Maybe Count -> Request k (Vector SimpleUser)
+usersFollowingR user = PagedQuery ["users", toPathPart user, "followers"] []
+
+-- | All the users that the given user follows.
+--
+-- > usersFollowedBy "mike-burns"
+usersFollowedBy :: Name User -> IO (Either Error (Vector SimpleUser))
+usersFollowedBy user =
+ executeRequest' $ usersFollowedByR user Nothing
+
+-- | List users followed by another user.
+-- See
+usersFollowedByR :: Name User -> Maybe Count -> Request k (Vector SimpleUser)
+usersFollowedByR user = PagedQuery ["users", toPathPart user, "following"] []
diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs
new file mode 100644
--- /dev/null
+++ b/src/GitHub/Request.hs
@@ -0,0 +1,343 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus
+--
+-- This module provides data types and helper methods, which makes possible
+-- to build alternative API request intepreters in addition to provided
+-- 'IO' functions.
+--
+-- Simple example using @operational@ package. See @samples\/Operational\/Operational.hs@
+--
+-- > type GithubMonad a = Program (GH.Request 'False) a
+-- >
+-- > -- | Intepret GithubMonad value into IO
+-- > runMonad :: Manager -> GH.Auth -> GithubMonad a -> ExceptT GH.Error IO a
+-- > runMonad mgr auth m = case view m of
+-- > Return a -> return a
+-- > req :>>= k -> do
+-- > b <- ExceptT $ GH.executeRequestWithMgr mgr auth req
+-- > runMonad mgr auth (k b)
+-- >
+-- > -- | Lift request into Monad
+-- > githubRequest :: GH.Request 'False a -> GithubMonad a
+-- > githubRequest = singleton
+module GitHub.Request (
+ -- * Types
+ Request(..),
+ CommandMethod(..),
+ toMethod,
+ Paths,
+ QueryString,
+ -- * Request execution in IO
+ executeRequest,
+ executeRequestWithMgr,
+ executeRequest',
+ executeRequestWithMgr',
+ executeRequestMaybe,
+ unsafeDropAuthRequirements,
+ -- * Helpers
+ makeHttpRequest,
+ parseResponse,
+ parseStatus,
+ getNextUrl,
+ performPagedRequest,
+ ) where
+
+import Prelude ()
+import Prelude.Compat
+
+#if MIN_VERSION_mtl(2,2,0)
+import Control.Monad.Except (MonadError (..))
+#else
+import Control.Monad.Error (MonadError (..))
+#endif
+
+import Control.Monad.Catch (MonadCatch (..), MonadThrow)
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.Trans.Except (ExceptT (..), runExceptT)
+import Data.Aeson.Compat (FromJSON, eitherDecode)
+import Data.List (find, intercalate)
+import Data.Semigroup (Semigroup (..))
+import Data.Text (Text)
+import Data.Vector.Instances ()
+
+import Network.HTTP.Client (CookieJar, HttpException (..), Manager,
+ RequestBody (..), Response (..),
+ applyBasicAuth, checkStatus, httpLbs,
+ method, newManager, parseUrl, requestBody,
+ requestHeaders, setQueryString)
+import Network.HTTP.Client.Internal (setUri)
+import Network.HTTP.Client.TLS (tlsManagerSettings)
+import Network.HTTP.Link.Parser (parseLinkHeaderBS)
+import Network.HTTP.Link.Types (Link (..), LinkParam (..), href,
+ linkParams)
+import Network.HTTP.Types (Method, RequestHeaders, ResponseHeaders,
+ Status (..))
+import Network.URI (URI)
+
+import qualified Control.Exception as E
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.Text as T
+import qualified Data.Vector as V
+import qualified Network.HTTP.Client as HTTP
+
+import GitHub.Auth (Auth (..))
+import GitHub.Data (Error (..))
+import GitHub.Data.Request
+
+-- | Execute 'Request' in 'IO'
+executeRequest :: Auth -> Request k a -> IO (Either Error a)
+executeRequest auth req = do
+ manager <- newManager tlsManagerSettings
+ x <- executeRequestWithMgr manager auth req
+#if !MIN_VERSION_http_client(0, 4, 18)
+ closeManager manager
+#endif
+ pure x
+
+-- | Like 'executeRequest' but with provided 'Manager'.
+executeRequestWithMgr :: Manager
+ -> Auth
+ -> Request k a
+ -> IO (Either Error a)
+executeRequestWithMgr mgr auth req = runExceptT $
+ case req of
+ Query {} -> do
+ httpReq <- makeHttpRequest (Just auth) req
+ res <- httpLbs' httpReq
+ parseResponse res
+ PagedQuery _ _ l -> do
+ httpReq <- makeHttpRequest (Just auth) req
+ performPagedRequest httpLbs' predicate httpReq
+ where
+ predicate = maybe (const True) (\l' -> (< l') . V.length ) l
+ Command m _ _ -> do
+ httpReq <- makeHttpRequest (Just auth) req
+ res <- httpLbs' httpReq
+ case m of
+ Delete -> pure ()
+ _ -> parseResponse res
+ StatusQuery sm _ -> do
+ httpReq <- makeHttpRequest (Just auth) req
+ res <- httpLbs' httpReq
+ parseStatus sm . responseStatus $ res
+ where
+ httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString)
+ httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException
+
+-- | Like 'executeRequest' but without authentication.
+executeRequest' :: Request 'False a -> IO (Either Error a)
+executeRequest' req = do
+ manager <- newManager tlsManagerSettings
+ x <- executeRequestWithMgr' manager req
+#if !MIN_VERSION_http_client(0, 4, 18)
+ closeManager manager
+#endif
+ pure x
+
+-- | Like 'executeRequestWithMgr' but without authentication.
+executeRequestWithMgr' :: Manager
+ -> Request 'False a
+ -> IO (Either Error a)
+executeRequestWithMgr' mgr req = runExceptT $
+ case req of
+ Query {} -> do
+ httpReq <- makeHttpRequest Nothing req
+ res <- httpLbs' httpReq
+ parseResponse res
+ PagedQuery _ _ l -> do
+ httpReq <- makeHttpRequest Nothing req
+ performPagedRequest httpLbs' predicate httpReq
+ where
+ predicate = maybe (const True) (\l' -> (< l') . V.length) l
+ StatusQuery sm _ -> do
+ httpReq <- makeHttpRequest Nothing req
+ res <- httpLbs' httpReq
+ parseStatus sm . responseStatus $ res
+ where
+ httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString)
+ httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException
+
+-- | Helper for picking between 'executeRequest' and 'executeRequest''.
+--
+-- The use is discouraged.
+executeRequestMaybe :: Maybe Auth -> Request 'False a
+ -> IO (Either Error a)
+executeRequestMaybe = maybe executeRequest' executeRequest
+
+-- | Partial function to drop authentication need.
+unsafeDropAuthRequirements :: Request 'True a -> Request k a
+unsafeDropAuthRequirements (Query ps qs) = Query ps qs
+unsafeDropAuthRequirements r =
+ error $ "Trying to drop authenatication from" ++ show r
+
+------------------------------------------------------------------------------
+-- Tools
+------------------------------------------------------------------------------
+
+-- | Create @http-client@ 'Request'.
+--
+-- * for 'PagedQuery', the initial request is created.
+-- * for 'Status', the 'Request' for underlying 'Request' is created,
+-- status checking is modifying accordingly.
+--
+-- @
+-- parseResponse :: 'Maybe' 'Auth' -> 'Request' k a -> 'Maybe' 'Request'
+-- @
+makeHttpRequest :: MonadThrow m
+ => Maybe Auth
+ -> Request k a
+ -> m HTTP.Request
+makeHttpRequest auth r = case r of
+ StatusQuery sm req -> do
+ req' <- makeHttpRequest auth req
+ return $ setCheckStatus (Just sm) req'
+ Query paths qs -> do
+ req <- parseUrl $ url paths
+ return $ setReqHeaders
+ . setCheckStatus Nothing
+ . setAuthRequest auth
+ . setQueryString qs
+ $ req
+ PagedQuery paths qs _ -> do
+ req <- parseUrl $ url paths
+ return $ setReqHeaders
+ . setCheckStatus Nothing
+ . setAuthRequest auth
+ . setQueryString qs
+ $ req
+ Command m paths body -> do
+ req <- parseUrl $ url paths
+ return $ setReqHeaders
+ . setCheckStatus Nothing
+ . setAuthRequest auth
+ . setBody body
+ . setMethod (toMethod m)
+ $ req
+ where
+ url :: Paths -> String
+ url paths = baseUrl ++ '/' : intercalate "/" paths
+
+ baseUrl :: String
+ baseUrl = case auth of
+ Just (EnterpriseOAuth endpoint _) -> endpoint
+ _ -> "https://api.github.com"
+
+ setReqHeaders :: HTTP.Request -> HTTP.Request
+ setReqHeaders req = req { requestHeaders = reqHeaders <> requestHeaders req }
+
+ setCheckStatus :: Maybe (StatusMap a) -> HTTP.Request -> HTTP.Request
+ setCheckStatus sm req = req { checkStatus = successOrMissing sm }
+
+ setMethod :: Method -> HTTP.Request -> HTTP.Request
+ setMethod m req = req { method = m }
+
+ reqHeaders :: RequestHeaders
+ reqHeaders = maybe [] getOAuthHeader auth
+ <> [("User-Agent", "github.hs/0.7.4")]
+ <> [("Accept", "application/vnd.github.preview")]
+
+ setBody :: LBS.ByteString -> HTTP.Request -> HTTP.Request
+ setBody body req = req { requestBody = RequestBodyLBS body }
+
+ setAuthRequest :: Maybe Auth -> HTTP.Request -> HTTP.Request
+ setAuthRequest (Just (BasicAuth user pass)) = applyBasicAuth user pass
+ setAuthRequest _ = id
+
+ getOAuthHeader :: Auth -> RequestHeaders
+ getOAuthHeader (OAuth token) = [("Authorization", "token " <> token)]
+ getOAuthHeader (EnterpriseOAuth _ token) = [("Authorization", "token " <> token)]
+ getOAuthHeader _ = []
+
+ successOrMissing :: Maybe (StatusMap a) -> Status -> ResponseHeaders -> CookieJar -> Maybe E.SomeException
+ successOrMissing sm s@(Status sci _) hs cookiejar
+ | check = Nothing
+ | otherwise = Just $ E.toException $ StatusCodeException s hs cookiejar
+ where
+ check = case sm of
+ Nothing -> 200 <= sci && sci < 300
+ Just StatusOnlyOk -> sci == 204 || sci == 404
+ Just StatusMerge -> sci `elem` [204, 405, 409]
+
+-- | Query @Link@ header with @rel=next@ from the request headers.
+getNextUrl :: Response a -> Maybe URI
+getNextUrl req = do
+ linkHeader <- lookup "Link" (responseHeaders req)
+ links <- parseLinkHeaderBS linkHeader
+ nextURI <- find isRelNext links
+ return $ href nextURI
+ where
+ isRelNext :: Link -> Bool
+ isRelNext = any (== relNextLinkParam) . linkParams
+
+ relNextLinkParam :: (LinkParam, Text)
+ relNextLinkParam = (Rel, "next")
+
+-- | Parse API response.
+--
+-- @
+-- parseResponse :: 'FromJSON' a => 'Response' 'LBS.ByteString' -> 'Either' 'Error' a
+-- @
+parseResponse :: (FromJSON a, MonadError Error m) => Response LBS.ByteString -> m a
+parseResponse res = case eitherDecode (responseBody res) of
+ Right x -> return x
+ Left err -> throwError . ParseError . T.pack $ err
+
+-- | Helper for handling of 'RequestStatus'.
+--
+-- @
+-- parseStatus :: 'StatusMap' a -> 'Status' -> 'Either' 'Error' a
+-- @
+parseStatus :: MonadError Error m => StatusMap a -> Status -> m a
+parseStatus StatusOnlyOk (Status sci _)
+ | sci == 204 = return True
+ | sci == 404 = return False
+ | otherwise = throwError $ JsonError $ "invalid status: " <> T.pack (show sci)
+parseStatus StatusMerge (Status sci _)
+ | sci == 204 = return MergeSuccessful
+ | sci == 405 = return MergeCannotPerform
+ | sci == 409 = return MergeConflict
+ | otherwise = throwError $ JsonError $ "invalid status: " <> T.pack (show sci)
+
+-- | Helper for making paginated requests. Responses, @a@ are combined monoidally.
+--
+-- @
+-- performPagedRequest :: ('FromJSON' a, 'Semigroup' a)
+-- => ('HTTP.Request' -> 'ExceptT' 'Error' 'IO' ('Response' 'LBS.ByteString'))
+-- -> (a -> 'Bool')
+-- -> 'HTTP.Request'
+-- -> 'ExceptT' 'Error' 'IO' a
+-- @
+performPagedRequest :: forall a m. (FromJSON a, Semigroup a, MonadCatch m, MonadError Error m)
+ => (HTTP.Request -> m (Response LBS.ByteString)) -- ^ `httpLbs` analogue
+ -> (a -> Bool) -- ^ predicate to continue iteration
+ -> HTTP.Request -- ^ initial request
+ -> m a
+performPagedRequest httpLbs' predicate initReq = do
+ res <- httpLbs' initReq
+ m <- parseResponse res
+ go m res initReq
+ where
+ go :: a -> Response LBS.ByteString -> HTTP.Request -> m a
+ go acc res req =
+ case (predicate acc, getNextUrl res) of
+ (True, Just uri) -> do
+ req' <- setUri req uri
+ res' <- httpLbs' req'
+ m <- parseResponse res'
+ go (acc <> m) res' req'
+ (_, _) -> return acc
+
+onHttpException :: MonadError Error m => HttpException -> m a
+onHttpException = throwError . HTTPError