packages feed

github 0.13.2 → 0.14.0

raw patch · 154 files changed

+6484/−4500 lines, 154 filesdep +aeson-compatdep +aeson-extradep +base-compatdep −HTTPdep −case-insensitivedep −conduitdep ~aesondep ~attoparsecdep ~basenew-uploader

Dependencies added: aeson-compat, aeson-extra, base-compat, binary, binary-orphans, deepseq, deepseq-generics, exceptions, file-embed, github, http-client, http-client-tls, http-link-header, iso8601-time, mtl, network-uri, semigroups, transformers, transformers-compat, vector-instances

Dependencies removed: HTTP, case-insensitive, conduit, data-default, failure, http-conduit, network, old-locale

Dependency ranges changed: aeson, attoparsec, base, base16-bytestring, byteable, bytestring, containers, cryptohash, hashable, http-types, text, time, unordered-containers, vector

Files

− Github/Auth.hs 
@@ -1,4 +0,0 @@--- | The Github auth data type-module Github.Auth (P.GithubAuth(..)) where--import qualified Github.Private as P
− Github/Data.hs 
@@ -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
− Github/Data/Definitions.hs 
@@ -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
− Github/Events.hs 
@@ -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
− Github/Gists.hs 
@@ -1,35 +0,0 @@--- | The gists API as described at <http://developer.github.com/v3/gists/>.-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
− Github/Gists/Comments.hs 
@@ -1,22 +0,0 @@--- | The loving comments people have left on Gists, described on--- <http://developer.github.com/v3/gists/comments/>.-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]
− Github/GitData/Blobs.hs 
@@ -1,16 +0,0 @@--- | The API for dealing with git blobs from Github repos, as described in--- <http://developer.github.com/v3/git/blobs/>.-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]
− Github/GitData/Commits.hs 
@@ -1,16 +0,0 @@--- | The API for underlying git commits of a Github repo, as described on--- <http://developer.github.com/v3/git/commits/>.-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]
− Github/GitData/References.hs 
@@ -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 <http://developer.github.com/v3/git/refs/>.-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]
− Github/GitData/Trees.hs 
@@ -1,37 +0,0 @@--- | The underlying tree of SHA1s and files that make up a git repo. The API is--- described on <http://developer.github.com/v3/git/trees/>.-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
− Github/Issues.hs 
@@ -1,129 +0,0 @@-{-# LANGUAGE CPP, OverloadedStrings #-}--- | The issues API as described on <http://developer.github.com/v3/issues/>.-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]
− Github/Issues/Comments.hs 
@@ -1,59 +0,0 @@--- | The Github issue comments API from--- <http://developer.github.com/v3/issues/comments/>.-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)
− Github/Issues/Events.hs 
@@ -1,56 +0,0 @@--- | The Github issue events API, which is described on--- <http://developer.github.com/v3/issues/events/>-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]
− Github/Issues/Labels.hs 
@@ -1,39 +0,0 @@--- | The API for dealing with labels on Github issues, as described on--- <http://developer.github.com/v3/issues/labels/>.-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]
− Github/Issues/Milestones.hs 
@@ -1,30 +0,0 @@--- | The milestones API as described on--- <http://developer.github.com/v3/issues/milestones/>.-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]
− Github/Organizations.hs 
@@ -1,35 +0,0 @@--- | The orgs API as described on <http://developer.github.com/v3/orgs/>.-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
− Github/Organizations/Members.hs 
@@ -1,15 +0,0 @@--- | The organization members API as described on--- <http://developer.github.com/v3/orgs/members/>.-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"]
− Github/Private.hs 
@@ -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)
− Github/PullRequests.hs 
@@ -1,114 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--- | The pull requests API as documented at--- <http://developer.github.com/v3/pulls/>.-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
− Github/Repos.hs 
@@ -1,342 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE CPP #-}--- | The Github Repos API, as documented at--- <http://developer.github.com/v3/repos/>-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
− Github/Repos/Collaborators.hs 
@@ -1,36 +0,0 @@--- | The repo collaborators API as described on--- <http://developer.github.com/v3/repos/collaborators/>.-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
− Github/Repos/Commits.hs 
@@ -1,53 +0,0 @@--- | The repo commits API as described on--- <http://developer.github.com/v3/repos/commits/>.-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]
− Github/Repos/Forks.hs 
@@ -1,24 +0,0 @@--- | Hot forking action, as described at--- <http://developer.github.com/v3/repos/forks/>.-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"]
− Github/Repos/Starring.hs 
@@ -1,28 +0,0 @@--- | The repo starring API as described on--- <http://developer.github.com/v3/repos/starring/>.-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"]
− Github/Repos/Subscribing.hs 
@@ -1,39 +0,0 @@--- | The repo subscribing API as described on--- <http://developer.github.com/v3/repos/watching/>.-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"]
− Github/Repos/Watching.hs 
@@ -1,39 +0,0 @@--- | The repo watching API as described on--- <http://developer.github.com/v3/repos/watching/>.-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"]
− Github/Repos/Webhooks.hs 
@@ -1,116 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE CPP #-}--- | The webhooks API, as described at--- <https://developer.github.com/v3/repos/hooks/>--- <https://developer.github.com/webhooks>--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
− Github/Repos/Webhooks/Validate.hs 
@@ -1,35 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- | Verification of incomming webhook payloads, as described at--- <https://developer.github.com/webhooks/securing/>--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
− Github/Search.hs 
@@ -1,42 +0,0 @@--- | The Github Search API, as described at--- <http://developer.github.com/v3/search/>.-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 --
− Github/Users.hs 
@@ -1,23 +0,0 @@--- | The Github Users API, as described at--- <http://developer.github.com/v3/users/>.-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
− Github/Users/Followers.hs 
@@ -1,22 +0,0 @@--- | The user followers API as described on--- <http://developer.github.com/v3/users/followers/>.-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"]
README.md view
@@ -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.
+ fixtures/issue-search.json view
@@ -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+    }+  ]+}
+ fixtures/list-teams.json view
@@ -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"+  }+]
+ fixtures/members-list.json view
@@ -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+  }+]
+ fixtures/user-organizations.json view
@@ -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"+  }+]
+ fixtures/user.json view
@@ -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"+}
github.cabal view
@@ -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: <https://github.com/jwiegley/github/blob/master/README.md>---- 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: <https://github.com/phadej/github/blob/master/README.md>+license:             BSD3+license-file:        LICENSE+author:              Mike Burns, John Wiegley, Oleg Grenrus+maintainer:          Oleg Grenrus <oleg.grenrus@iki.fi>+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
− samples/Gists/Comments/ShowComment.hs 
@@ -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
− samples/Gists/Comments/ShowComments.hs 
@@ -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
− samples/Gists/ListGists.hs 
@@ -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)
− samples/Gists/ShowGist.hs 
@@ -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)
− samples/GitData/Commits/GitShow.hs 
@@ -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) ++ ">"-
− samples/GitData/References/GitCreateReference.hs 
@@ -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)
− samples/GitData/References/GitLsRemote.hs 
@@ -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)
− samples/GitData/References/GitLsRemoteTags.hs 
@@ -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)-
− samples/GitData/References/GitLsRemoteWithRef.hs 
@@ -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)
− samples/GitData/Trees/GitLsTree.hs 
@@ -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)
− samples/GitData/Trees/GitLsTreeRecursively.hs 
@@ -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)
− samples/Issues/Comments/ShowComment.hs 
@@ -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)
− samples/Issues/Comments/ShowComments.hs 
@@ -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)
− samples/Issues/Events/ShowEvent.hs 
@@ -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)
− samples/Issues/Events/ShowIssueEvents.hs 
@@ -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)
− samples/Issues/Events/ShowRepoEvents.hs 
@@ -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
− samples/Issues/Labels/ShowIssueLabels.hs 
@@ -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)
− samples/Issues/Labels/ShowLabel.hs 
@@ -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)-
− samples/Issues/Labels/ShowMilestoneLabels.hs 
@@ -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)-
− samples/Issues/Labels/ShowRepoLabels.hs 
@@ -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)
− samples/Issues/Milestones/ShowMilestone.hs 
@@ -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
− samples/Issues/Milestones/ShowMilestones.hs 
@@ -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
− samples/Issues/ShowIssue.hs 
@@ -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)
− samples/Issues/ShowRepoIssues.hs 
@@ -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)-
− samples/Organizations/Members/ShowMembers.hs 
@@ -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
− samples/Organizations/ShowPublicOrganization.hs 
@@ -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))
− samples/Organizations/ShowPublicOrganizations.hs 
@@ -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
− samples/Pulls/Diff.hs 
@@ -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
− samples/Pulls/ListPulls.hs 
@@ -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
− samples/Pulls/ReviewComments/ListComments.hs 
@@ -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) ++ ")"
− samples/Pulls/ReviewComments/ShowComment.hs 
@@ -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) ++ ")"-
− samples/Pulls/ShowCommits.hs 
@@ -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) ++ ">"
− samples/Pulls/ShowPull.hs 
@@ -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
− samples/Repos/Collaborators/IsCollaborator.hs 
@@ -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"
− samples/Repos/Collaborators/ListCollaborators.hs 
@@ -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) ++ ")"
− samples/Repos/Commits/CommitComment.hs 
@@ -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) ++ ")"
− samples/Repos/Commits/CommitComments.hs 
@@ -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) ++ ")"
− samples/Repos/Commits/GitDiff.hs 
@@ -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
− samples/Repos/Commits/GitLog.hs 
@@ -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) ++ ">"
− samples/Repos/Commits/GitShow.hs 
@@ -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) ++ ">"-
− samples/Repos/Commits/RepoComments.hs 
@@ -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) ++ ")"
− samples/Repos/Forks/ListForks.hs 
@@ -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
− samples/Repos/ListBranches.hs 
@@ -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
− samples/Repos/ListContributors.hs 
@@ -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
− samples/Repos/ListContributorsWithAnonymous.hs 
@@ -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
− samples/Repos/ListLanguages.hs 
@@ -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
− samples/Repos/ListOrgRepos.hs 
@@ -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 = ""
− samples/Repos/ListTags.hs 
@@ -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
− samples/Repos/ListUserRepos.hs 
@@ -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 = ""
− samples/Repos/ShowRepo.hs 
@@ -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 = ""
− samples/Repos/Starring/ListStarred.hs 
@@ -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 = ""
− samples/Repos/Watching/ListWatched.hs 
@@ -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 = ""
− samples/Repos/Watching/ListWatchers.hs 
@@ -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) ++ ")"
− samples/Repos/Webhooks/CreateWebhook.hs 
@@ -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
− samples/Repos/Webhooks/DeleteWebhook.hs 
@@ -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)
− samples/Repos/Webhooks/EditWebhook.hs 
@@ -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
− samples/Repos/Webhooks/ListWebhook.hs 
@@ -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
− samples/Repos/Webhooks/ListWebhooks.hs 
@@ -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
− samples/Repos/Webhooks/PingWebhook.hs 
@@ -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)
− samples/Repos/Webhooks/TestPushWebhook.hs 
@@ -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)
− samples/Search/SearchRepos.hs 
@@ -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
− samples/Users/Followers/ListFollowers.hs 
@@ -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
− samples/Users/Followers/ListFollowing.hs 
@@ -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-
− samples/Users/ShowUser.hs 
@@ -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
+ spec/GitHub/ActivitySpec.hs view
@@ -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)
+ spec/GitHub/CommitsSpec.hs view
@@ -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
+ spec/GitHub/OrganizationsSpec.hs view
@@ -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
+ spec/GitHub/ReposSpec.hs view
@@ -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"
+ spec/GitHub/SearchSpec.hs view
@@ -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
+ spec/GitHub/UsersSpec.hs view
@@ -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
+ src/GitHub.hs view
@@ -0,0 +1,335 @@+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- 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 <https://developer.github.com/v3/activity/>++    -- ** Starring+    -- | See <https://developer.github.com/v3/activity/starring/>+    --+    -- Missing endpoints:+    --+    -- * Check if you are starring a repository+    -- * Star a repository+    -- * Unstar a repository+    stargazersForR,+    reposStarredByR,+    myStarredR,++    -- ** Watching+    -- | See <https://developer.github.com/v3/activity/>+    --+    -- Missing endpoints:+    --+    -- * Query a Repository Subscription+    -- * Set a Repository Subscription+    -- * Delete a Repository Subscription+    watchersForR,+    reposWatchedByR,++    -- * Gists+    -- | See <https://developer.github.com/v3/gists/>+    --+    -- 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 <https://developer.github.com/v3/gists/comments/>+    --+    -- Missing endpoints:+    -- * Create a comment+    -- * Edit a comment+    -- * Delete a comment+    commentsOnR,+    gistCommentR,++    -- * Git Data+    -- | See <https://developer.github.com/v3/git/>++    -- ** Blobs+    -- | See <https://developer.github.com/v3/git/blobs/>+    blobR,++    -- ** Commits+    -- | See <https://developer.github.com/v3/git/commits/>+    gitCommitR,++    -- ** References+    -- | See <https://developer.github.com/v3/git/refs/>+    referenceR,+    referencesR,+    createReferenceR,++    -- ** Trees+    -- | See <https://developer.github.com/v3/git/trees/>+    treeR,+    nestedTreeR,++    -- * Issues+    -- | See <https://developer.github.com/v3/issues/>+    --+    -- Missing endpoints:+    --+    -- * List issues+    issueR,+    issuesForRepoR,+    createIssueR,+    editIssueR,++    -- ** Comments+    -- | See <https://developer.github.com/v3/issues/comments/>+    --+    -- Missing endpoints:+    --+    -- * Delete comment+    commentR,+    commentsR,+    createCommentR,+    editCommentR,++    -- ** Events+    -- | See <https://developer.github.com/v3/issues/events/>+    --+    eventsForIssueR,+    eventsForRepoR,+    eventR,++    -- ** Labels+    -- | See <https://developer.github.com/v3/issues/labels/>+    --+    labelsOnRepoR,+    labelR,+    createLabelR,+    updateLabelR,+    deleteLabelR,+    labelsOnIssueR,+    addLabelsToIssueR,+    removeLabelFromIssueR,+    replaceAllLabelsForIssueR,+    removeAllLabelsFromIssueR,+    labelsOnMilestoneR,++    -- ** Milestone+    -- | See <https://developer.github.com/v3/issues/milestones/>+    --+    -- Missing endpoints:+    --+    -- * Create a milestone+    -- * Update a milestone+    -- * Delete a milestone+    milestonesR,+    milestoneR,++    -- * Organizations+    -- | See <https://developer.github.com/v3/orgs/>+    --+    -- Missing endpoints:+    --+    -- * List your organizations+    -- * List all organizations+    -- * Edit an organization+    publicOrganizationsForR,+    publicOrganizationR,+    -- ** Members+    -- | See <https://developer.github.com/v3/orgs/members/>+    --+    -- Missing endpoints: All except /Members List/+    membersOfR,++    -- ** Teams+    -- | See <https://developer.github.com/v3/orgs/teams/>+    --+    -- 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 <https://developer.github.com/v3/pulls/>+    pullRequestsForR,+    pullRequestR,+    createPullRequestR,+    updatePullRequestR,+    pullRequestCommitsR,+    pullRequestFilesR,+    isPullRequestMergedR,+    mergePullRequestR,++    -- ** Review comments+    -- | See <https://developer.github.com/v3/pulls/comments/>+    --+    -- Missing endpoints:+    --+    -- * List comments in a repository+    -- * Create a comment+    -- * Edit a comment+    -- * Delete a comment+    pullRequestReviewCommentsR,+    pullRequestReviewCommentR,++    -- * Repositories+    -- | See <https://developer.github.com/v3/repos/>+    --+    -- 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 <https://developer.github.com/v3/repos/collaborators/>+    collaboratorsOnR,+    isCollaboratorOnR,++    -- ** Comments+    -- | See <https://developer.github.com/v3/repos/comments/>+    --+    -- Missing endpoints:+    --+    -- * Create a commit comment+    -- * Update a commit comment+    -- *  Delete a commit comment+    commentsForR,+    commitCommentsForR,+    commitCommentForR,++    -- ** Commits+    -- | See <https://developer.github.com/v3/repos/commits/>+    commitsForR,+    commitsWithOptionsForR,+    commitR,+    diffR,++    -- ** Forks+    -- | See <https://developer.github.com/v3/repos/forks/>+    --+    -- Missing endpoints:+    --+    -- * Create a fork+    forksForR,++    -- ** Webhooks+    -- | See <https://developer.github.com/v3/repos/hooks/>+    webhooksForR,+    webhookForR,+    createRepoWebhookR,+    editRepoWebhookR,+    testPushRepoWebhookR,+    pingRepoWebhookR,+    deleteRepoWebhookR,++    -- * Search+    -- | See <https://developer.github.com/v3/search/>+    --+    -- Missing endpoints:+    --+    -- * Search users+    searchReposR,+    searchCodeR,+    searchIssuesR,++    -- * Users+    -- | See <https://developer.github.com/v3/users/>+    --+    -- Missing endpoints:+    --+    -- * Update the authenticated user+    -- * Query all users+    userInfoForR,+    ownerInfoForR,+    userInfoCurrentR,++    -- ** Followers+    -- | See <https://developer.github.com/v3/users/followers/>+    --+    -- 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
+ src/GitHub/Auth.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+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
+ src/GitHub/Data.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE CPP                #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings  #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- 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
+ src/GitHub/Data/Comments.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE OverloadedStrings  #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+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 ]
+ src/GitHub/Data/Content.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE OverloadedStrings  #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+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"
+ src/GitHub/Data/Definitions.hs view
@@ -0,0 +1,231 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE OverloadedStrings  #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+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
+ src/GitHub/Data/Gists.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE OverloadedStrings  #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+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"
+ src/GitHub/Data/GitData.hs view
@@ -0,0 +1,313 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE OverloadedStrings  #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+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"
+ src/GitHub/Data/Id.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+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
+ src/GitHub/Data/Issues.hs view
@@ -0,0 +1,275 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE OverloadedStrings  #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+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"
+ src/GitHub/Data/Name.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+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
+ src/GitHub/Data/PullRequests.hs view
@@ -0,0 +1,291 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE OverloadedStrings  #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+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"
+ src/GitHub/Data/Repos.hs view
@@ -0,0 +1,266 @@+{-# LANGUAGE CPP                #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE FlexibleInstances  #-}+{-# LANGUAGE OverloadedStrings  #-}+#define UNSAFE 1+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- 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
+ src/GitHub/Data/Request.hs view
@@ -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 <oleg.grenrus@iki.fi>+--+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
+ src/GitHub/Data/Search.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE OverloadedStrings  #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+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"
+ src/GitHub/Data/Teams.hs view
@@ -0,0 +1,245 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE OverloadedStrings  #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+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"
+ src/GitHub/Data/Webhooks.hs view
@@ -0,0 +1,207 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE OverloadedStrings  #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+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"
+ src/GitHub/Data/Webhooks/Validate.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- Verification of incomming webhook payloads, as described at+-- <https://developer.github.com/webhooks/securing/>+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
+ src/GitHub/Endpoints/Activity/Starring.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE DataKinds #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- The repo starring API as described on+-- <https://developer.github.com/v3/activity/starring/>.+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 <https://developer.github.com/v3/activity/starring/#list-stargazers>+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 <https://developer.github.com/v3/activity/starring/#list-repositories-being-starred>+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"] []
+ src/GitHub/Endpoints/Activity/Watching.hs view
@@ -0,0 +1,61 @@+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- The repo watching API as described on+-- <https://developer.github.com/v3/activity/watching/>.+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 <https://developer.github.com/v3/activity/watching/#list-watchers>+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 <https://developer.github.com/v3/activity/watching/#list-repositories-being-watched>+reposWatchedByR :: Name Owner -> Maybe Count -> Request k (Vector Repo)+reposWatchedByR user =+    PagedQuery ["users", toPathPart user, "subscriptions"] []
+ src/GitHub/Endpoints/Gists.hs view
@@ -0,0 +1,56 @@+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- The gists API as described at <http://developer.github.com/v3/gists/>.+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 <https://developer.github.com/v3/gists/#list-gists>+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 <https://developer.github.com/v3/gists/#get-a-single-gist>+gistR :: Name Gist ->Request k Gist+gistR gid =+    Query ["gists", toPathPart gid] []
+ src/GitHub/Endpoints/Gists/Comments.hs view
@@ -0,0 +1,45 @@+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- The loving comments people have left on Gists, described on+-- <http://developer.github.com/v3/gists/comments/>.+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 <https://developer.github.com/v3/gists/comments/#list-comments-on-a-gist>+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 <https://developer.github.com/v3/gists/comments/#get-a-single-comment>+gistCommentR :: Id GistComment -> Request k GistComment+gistCommentR cid =+    Query ["gists", "comments", toPathPart cid] []
+ src/GitHub/Endpoints/GitData/Blobs.hs view
@@ -0,0 +1,35 @@+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- The API for dealing with git blobs from Github repos, as described in+-- <http://developer.github.com/v3/git/blobs/>.+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 <https://developer.github.com/v3/git/blobs/#get-a-blob>+blobR :: Name Owner -> Name Repo -> Name Blob -> Request k Blob+blobR user repo sha =+    Query ["repos", toPathPart user, toPathPart repo, "git", "blobs", toPathPart sha] []
+ src/GitHub/Endpoints/GitData/Commits.hs view
@@ -0,0 +1,28 @@+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- The API for underlying git commits of a Github repo, as described on+-- <http://developer.github.com/v3/git/commits/>.+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 <https://developer.github.com/v3/git/commits/#get-a-commit>+gitCommitR :: Name Owner -> Name Repo -> Name GitCommit -> Request k GitCommit+gitCommitR user repo sha =+    Query ["repos", toPathPart user, toPathPart repo, "git", "commits", toPathPart sha] []
+ src/GitHub/Endpoints/GitData/References.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE DataKinds #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- 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 <http://developer.github.com/v3/git/refs/>.+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 <https://developer.github.com/v3/git/refs/#get-a-reference>+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 <https://developer.github.com/v3/git/refs/#get-all-references>+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 <https://developer.github.com/v3/git/refs/#create-a-reference>+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 <https://developer.github.com/v3/git/refs/#get-all-references>+namespacedReferencesR :: Name Owner -> Name Repo -> String -> Request k [GitReference]+namespacedReferencesR user repo namespace =+    Query ["repos", toPathPart user, toPathPart repo, "git", "refs", namespace] []
+ src/GitHub/Endpoints/GitData/Trees.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- The underlying tree of SHA1s and files that make up a git repo. The API is+-- described on <http://developer.github.com/v3/git/trees/>.+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 <https://developer.github.com/v3/git/trees/#get-a-tree>+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 <https://developer.github.com/v3/git/trees/#get-a-tree-recursively>+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")]
+ src/GitHub/Endpoints/Issues.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- The issues API as described on <http://developer.github.com/v3/issues/>.+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 <https://developer.github.com/v3/issues/#get-a-single-issue>+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 <https://developer.github.com/v3/issues/#list-issues-for-a-repository>+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 <https://developer.github.com/v3/issues/#create-an-issue>+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 <https://developer.github.com/v3/issues/#edit-an-issue>+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
+ src/GitHub/Endpoints/Issues/Comments.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE DataKinds #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- The Github issue comments API from+-- <http://developer.github.com/v3/issues/comments/>.+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 <https://developer.github.com/v3/issues/comments/#get-a-single-comment>+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 <https://developer.github.com/v3/issues/comments/#list-comments-on-an-issue>+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 <https://developer.github.com/v3/issues/comments/#create-a-comment>+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 <https://developer.github.com/v3/issues/comments/#edit-a-comment>+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]
+ src/GitHub/Endpoints/Issues/Events.hs view
@@ -0,0 +1,81 @@+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- The Github issue events API, which is described on+-- <http://developer.github.com/v3/issues/events/>+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 <https://developer.github.com/v3/issues/events/#list-events-for-an-issue>+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 <https://developer.github.com/v3/issues/events/#list-events-for-a-repository>+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 <https://developer.github.com/v3/issues/events/#get-a-single-event>+eventR :: Name Owner -> Name Repo -> Id Event -> Request k Event+eventR user repo eid =+    Query ["repos", toPathPart user, toPathPart repo, "issues", "events", show eid] []
+ src/GitHub/Endpoints/Issues/Labels.hs view
@@ -0,0 +1,260 @@+{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- The API for dealing with labels on Github issues as described on+-- <http://developer.github.com/v3/issues/labels/>.+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 <https://developer.github.com/v3/issues/labels/#list-all-labels-for-this-repository>+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 <https://developer.github.com/v3/issues/labels/#get-a-single-label>+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 <https://developer.github.com/v3/issues/labels/#create-a-label>+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 <https://developer.github.com/v3/issues/labels/#update-a-label>+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 <https://developer.github.com/v3/issues/labels/#delete-a-label>+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 <https://developer.github.com/v3/issues/labels/#list-labels-on-an-issue>+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 <https://developer.github.com/v3/issues/labels/#add-labels-to-an-issue>+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 <https://developer.github.com/v3/issues/labels/#remove-a-label-from-an-issue>+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 <https://developer.github.com/v3/issues/labels/#replace-all-labels-for-an-issue>+--+-- 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 <https://developer.github.com/v3/issues/labels/#remove-all-labels-from-an-issue>+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 <https://developer.github.com/v3/issues/labels/#get-labels-for-every-issue-in-a-milestone>+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"] []
+ src/GitHub/Endpoints/Issues/Milestones.hs view
@@ -0,0 +1,51 @@+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- The milestones API as described on+-- <http://developer.github.com/v3/issues/milestones/>.+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 <https://developer.github.com/v3/issues/milestones/#list-milestones-for-a-repository>+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 <https://developer.github.com/v3/issues/milestones/#get-a-single-milestone>+milestoneR :: Name Owner -> Name Repo -> Id Milestone -> Request k Milestone+milestoneR user repo mid =+    Query ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid] []
+ src/GitHub/Endpoints/Organizations.hs view
@@ -0,0 +1,54 @@+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- The orgs API as described on <http://developer.github.com/v3/orgs/>.+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 <https://developer.github.com/v3/orgs/#list-user-organizations>+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 <https://developer.github.com/v3/orgs/#get-an-organization>+publicOrganizationR :: Name Organization -> Request k Organization+publicOrganizationR reqOrganizationName = Query ["orgs", toPathPart reqOrganizationName] []
+ src/GitHub/Endpoints/Organizations/Members.hs view
@@ -0,0 +1,39 @@+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- The organization members API as described on+-- <http://developer.github.com/v3/orgs/members/>.+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 <https://developer.github.com/v3/orgs/members/#members-list>+membersOfR :: Name Organization -> Maybe Count -> Request k (Vector SimpleUser)+membersOfR organization = PagedQuery ["orgs", toPathPart organization, "members"] []
+ src/GitHub/Endpoints/Organizations/Teams.hs view
@@ -0,0 +1,183 @@+{-# LANGUAGE DataKinds #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- The Owner teams API as described on+-- <http://developer.github.com/v3/orgs/teams/>.+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 <https://developer.github.com/v3/orgs/teams/#list-teams>+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 <https://developer.github.com/v3/orgs/teams/#get-team>+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 <https://developer.github.com/v3/orgs/teams/#create-team>+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 <https://developer.github.com/v3/orgs/teams/#edit-team>+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 <https://developer.github.com/v3/orgs/teams/#delete-team>+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 <https://developer.github.com/v3/orgs/teams/#get-team-membership+teamMembershipInfoForR :: Id Team -> 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 <https://developer.github.com/v3/orgs/teams/#add-team-membership>+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 <https://developer.github.com/v3/orgs/teams/#remove-team-membership>+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 <https://developer.github.com/v3/orgs/teams/#list-user-teams>+listTeamsCurrentR :: Maybe Count -> Request 'True (Vector Team)+listTeamsCurrentR = PagedQuery ["user", "teams"] []
+ src/GitHub/Endpoints/PullRequests.hs view
@@ -0,0 +1,203 @@+{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- The pull requests API as documented at+-- <http://developer.github.com/v3/pulls/>.+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 <https://developer.github.com/v3/pulls/#list-pull-requests>+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 <https://developer.github.com/v3/pulls/#get-a-single-pull-request>+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 <https://developer.github.com/v3/pulls/#create-a-pull-request>+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 <https://developer.github.com/v3/pulls/#update-a-pull-request>+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 <https://developer.github.com/v3/pulls/#list-commits-on-a-pull-request>+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 <https://developer.github.com/v3/pulls/#list-pull-requests-files>+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 <https://developer.github.com/v3/pulls/#get-if-a-pull-request-has-been-merged>+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 []+
+ src/GitHub/Endpoints/PullRequests/ReviewComments.hs view
@@ -0,0 +1,44 @@+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- The pull request review comments API as described at+-- <http://developer.github.com/v3/pulls/comments/>.+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 <https://developer.github.com/v3/pulls/comments/#list-comments-on-a-pull-request>+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 <https://developer.github.com/v3/pulls/comments/#get-a-single-comment>+pullRequestReviewCommentR :: Name Owner -> Name Repo -> Id Comment -> Request k Comment+pullRequestReviewCommentR user repo cid =+    Query ["repos", toPathPart user, toPathPart repo, "pulls", "comments", toPathPart cid] []
+ src/GitHub/Endpoints/Repos.hs view
@@ -0,0 +1,364 @@+{-# LANGUAGE DataKinds          #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE OverloadedStrings  #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- The Github Repos API, as documented at+-- <http://developer.github.com/v3/repos/>+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 <https://developer.github.com/v3/repos/#list-your-repositories>+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 <https://developer.github.com/v3/repos/#list-user-repositories>+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 <https://developer.github.com/v3/repos/#list-organization-repositories>+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 <https://developer.github.com/v3/repos/#get>+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 <https://developer.github.com/v3/repos/#create>+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 <https://developer.github.com/v3/repos/#create>+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 <https://developer.github.com/v3/repos/#edit>+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 <https://developer.github.com/v3/repos/#list-contributors>+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 <https://developer.github.com/v3/repos/#list-languages>+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 <https://developer.github.com/v3/repos/#list-tags>+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 <https://developer.github.com/v3/repos/#list-branches>+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
+ src/GitHub/Endpoints/Repos/Collaborators.hs view
@@ -0,0 +1,59 @@+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- The repo collaborators API as described on+-- <http://developer.github.com/v3/repos/collaborators/>.+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 <https://developer.github.com/v3/repos/collaborators/#list-collaborators>+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 <https://developer.github.com/v3/repos/collaborators/#check-if-a-user-is-a-collaborator>+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] []
+ src/GitHub/Endpoints/Repos/Comments.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE CPP #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- The repo commits API as described on+-- <http://developer.github.com/v3/repos/comments/>.+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 <https://developer.github.com/v3/repos/comments/#list-commit-comments-for-a-repository>+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 <https://developer.github.com/v3/repos/comments/#list-comments-for-a-single-commit>+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 <https://developer.github.com/v3/repos/comments/#get-a-single-commit-comment>+commitCommentForR :: Name Owner -> Name Repo -> Id Comment -> Request k Comment+commitCommentForR user repo cid =+    Query ["repos", toPathPart user, toPathPart repo, "comments", toPathPart cid] []
+ src/GitHub/Endpoints/Repos/Commits.hs view
@@ -0,0 +1,121 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- The repo commits API as described on+-- <http://developer.github.com/v3/repos/commits/>.+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 <https://developer.github.com/v3/repos/commits/#list-commits-on-a-repository>+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 <https://developer.github.com/v3/repos/commits/#list-commits-on-a-repository>+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 <https://developer.github.com/v3/repos/commits/#get-a-single-commit>+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 <https://developer.github.com/v3/repos/commits/#compare-two-commits>+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] []
+ src/GitHub/Endpoints/Repos/Forks.hs view
@@ -0,0 +1,37 @@+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- Hot forking action, as described at+-- <http://developer.github.com/v3/repos/forks/>.+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 <https://developer.github.com/v3/repos/forks/#list-forks>+forksForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Repo)+forksForR user repo =+    PagedQuery ["repos", toPathPart user, toPathPart repo, "forks"] []
+ src/GitHub/Endpoints/Repos/Webhooks.hs view
@@ -0,0 +1,121 @@+{-# LANGUAGE DataKinds #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- The webhooks API, as described at+-- <https://developer.github.com/v3/repos/hooks/>+-- <https://developer.github.com/webhooks>+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 <https://developer.github.com/v3/repos/hooks/#list-hooks>+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 <https://developer.github.com/v3/repos/hooks/#get-single-hook>+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 <https://developer.github.com/v3/repos/hooks/#create-a-hook>+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 <https://developer.github.com/v3/repos/hooks/#edit-a-hook>+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 <https://developer.github.com/v3/repos/hooks/#test-a-push-hook>+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 <https://developer.github.com/v3/repos/hooks/#ping-a-hook>+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 <https://developer.github.com/v3/repos/hooks/#delete-a-hook>+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]
+ src/GitHub/Endpoints/Search.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- The Github Search API, as described at+-- <http://developer.github.com/v3/search/>.+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 <https://developer.github.com/v3/search/#search-repositories>+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 <https://developer.github.com/v3/search/#search-code>+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 <https://developer.github.com/v3/search/#search-issues>+searchIssuesR :: Text -> Request k (SearchResult Issue)+searchIssuesR searchString = Query ["search", "issues"] [("q", Just $ TE.encodeUtf8 searchString)]
+ src/GitHub/Endpoints/Users.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE DataKinds #-}+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- The Github Users API, as described at+-- <http://developer.github.com/v3/users/>.+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 <https://developer.github.com/v3/users/#get-a-single-user>+userInfoForR :: Name User -> Request k User+userInfoForR user = Query ["users", toPathPart user] []++-- | Query a single user or an organization.+-- See <https://developer.github.com/v3/users/#get-a-single-user>+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 <https://developer.github.com/v3/users/#get-the-authenticated-user>+userInfoCurrentR :: Request 'True User+userInfoCurrentR = Query ["user"] []
+ src/GitHub/Endpoints/Users/Followers.hs view
@@ -0,0 +1,43 @@+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- The user followers API as described on+-- <http://developer.github.com/v3/users/followers/>.+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 <https://developer.github.com/v3/users/followers/#list-followers-of-a-user>+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 <https://developer.github.com/v3/users/followers/#list-users-followed-by-another-user>+usersFollowedByR :: Name User -> Maybe Count -> Request k (Vector SimpleUser)+usersFollowedByR user = PagedQuery ["users", toPathPart user, "following"] []
+ src/GitHub/Request.hs view
@@ -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 <oleg.grenrus@iki.fi>+--+-- 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