diff --git a/Github/Data.hs b/Github/Data.hs new file mode 100644 --- /dev/null +++ b/Github/Data.hs @@ -0,0 +1,479 @@ +{-# LANGUAGE 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 Data.Time +import Control.Applicative +import Control.Monad +import qualified Data.Map as Map +import qualified Data.Text as T +import Data.Aeson.Types +import System.Locale (defaultTimeLocale) +import Data.Attoparsec.Number (Number(..)) +import qualified Data.Vector as V + +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 GithubUser where + parseJSON (Object o) = + GithubUser <$> o .: "avatar_url" + <*> o .: "login" + <*> o .: "url" + <*> o .: "id" + <*> o .: "gravatar_id" + parseJSON v = fail $ "Could not build a GithubUser 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 FromJSON Diff where + parseJSON (Object o) = + Diff <$> o .: "status" + <*> o .: "behind_by" + <*> o .: "patch_url" + <*> o .: "url" + <*> o .: "base_commit" + <*> o .:< "commits" + <*> o .: "total_commits" + <*> o .: "html_url" + <*> o .:< "files" + <*> o .: "ahead_by" + <*> o .: "diff_url" + <*> o .: "permalink_url" + parseJSON _ = fail "Could not build a Diff" + +instance FromJSON Gist where + parseJSON (Object o) = + Gist <$> o .: "user" + <*> o .: "git_push_url" + <*> o .: "url" + <*> o .:? "description" + <*> o .: "created_at" + <*> o .: "public" + <*> o .: "comments" + <*> o .: "updated_at" + <*> o .: "html_url" + <*> o .: "id" + <*> o `values` "files" + <*> o .: "git_push_url" + parseJSON _ = fail "Could not build a Gist" + +instance FromJSON GistFile where + parseJSON (Object o) = + GistFile <$> o .: "type" + <*> o .: "raw_url" + <*> o .: "size" + <*> o .:? "language" + <*> o .: "filename" + <*> o .:? "content" + parseJSON _ = fail "Could not build a GistFile" + +instance FromJSON GistComment where + parseJSON (Object o) = + GistComment <$> o .: "user" + <*> o .: "url" + <*> o .: "created_at" + <*> o .: "body" + <*> o .: "updated_at" + <*> o .: "id" + parseJSON _ = fail "Could not build a GistComment" + +instance FromJSON Blob where + parseJSON (Object o) = + Blob <$> o .: "url" + <*> o .: "encoding" + <*> o .: "content" + <*> o .: "sha" + <*> o .: "size" + parseJSON _ = fail "Could not build a Blob" + +instance FromJSON GitReference where + parseJSON (Object o) = + GitReference <$> o .: "object" + <*> o .: "url" + <*> o .: "ref" + parseJSON _ = fail "Could not build a GitReference" + +instance FromJSON GitObject where + parseJSON (Object o) = + GitObject <$> o .: "type" + <*> o .: "sha" + <*> o .: "url" + parseJSON _ = fail "Could not build a GitObject" + +instance FromJSON Issue where + parseJSON (Object o) = + Issue <$> o .:? "closed_at" + <*> o .: "updated_at" + <*> o .: "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 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 _ = 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 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) = + return PullRequestCommit + parseJSON _ = fail "Could not build a PullRequestCommit" + +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" + parseJSON _ = fail "Could not build a Repo" + +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 DetailedUser where + parseJSON (Object o) = + 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 DetailedUser" + + +-- | 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. +obj `values` key = + let (Object children) = Map.findWithDefault (Object Map.empty) key obj in + parseJSON $ Array $ V.fromList $ Map.elems children + +-- | Produce the value for the last key by traversing. +obj <.:> [key] = obj .: key +obj <.:> (key:keys) = + let (Object nextObj) = Map.findWithDefault (Object Map.empty) key obj in + nextObj <.:> keys + +-- | Produce the value for the given key, maybe. +at :: Object -> T.Text -> Maybe Value +obj `at` key = Map.lookup key obj diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs new file mode 100644 --- /dev/null +++ b/Github/Data/Definitions.hs @@ -0,0 +1,420 @@ +{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} + +module Github.Data.Definitions where + +import Data.Time +import Data.Data +import Network.HTTP.Enumerator (HttpException(..)) +import qualified Control.Exception as E + +deriving instance Eq Network.HTTP.Enumerator.HttpException + +-- | Errors have been tagged according to their source, so you can more easily +-- dispatch and handle them. +data Error = + HTTPConnectionError E.IOException -- ^ A HTTP error occurred. The actual caught error is included, if available. + | ParseError String -- ^ An error in the parser itself. + | JsonError String -- ^ The JSON is malformed or unexpected. + | UserError String -- ^ Incorrect input. + deriving (Show, Eq) + +-- | 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 GithubUser + ,commitAuthor :: Maybe GithubUser + ,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 + ,gitTreeUrl :: 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 GithubUser = GithubUser { + githubUserAvatarUrl :: String + ,githubUserLogin :: String + ,githubUserUrl :: String + ,githubUserId :: Int + ,githubUserGravatarId :: String +} 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 :: String + ,commentUpdatedAt :: UTCTime + ,commentHtmlUrl :: Maybe String + ,commentUrl :: String + ,commentCreatedAt :: UTCTime + ,commentPath :: Maybe String + ,commentUser :: GithubUser + ,commentId :: Int +} 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 :: GithubUser + ,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 :: GithubUser + ,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 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 + ,issueHtmlUrl :: String + ,issueClosedBy :: Maybe String + ,issueLabels :: [IssueLabel] + ,issueNumber :: Int + ,issueAssignee :: Maybe GithubUser + ,issueUser :: GithubUser + ,issueTitle :: String + ,issuePullRequest :: PullRequestReference + ,issueUrl :: String + ,issueCreatedAt :: GithubDate + ,issueBody :: String + ,issueState :: String + ,issueId :: Int + ,issueComments :: Int + ,issueMilestone :: Maybe Milestone +} deriving (Show, Data, Typeable, Eq, Ord) + +data Milestone = Milestone { + milestoneCreator :: GithubUser + ,milestoneDueOn :: GithubDate + ,milestoneOpenIssues :: Int + ,milestoneNumber :: Int + ,milestoneClosedIssues :: Int + ,milestoneDescription :: 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 :: GithubUser + ,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. + deriving (Show, Data, Typeable, Eq, Ord) + +data Event = Event { + eventActor :: GithubUser + ,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 :: GithubUser + ,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 :: GithubUser + ,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 GithubUser + ,detailedPullRequestChangedFiles :: Int + ,detailedPullRequestHead :: PullRequestCommit + ,detailedPullRequestComments :: Int + ,detailedPullRequestDeletions :: Int + ,detailedPullRequestAdditions :: Int + ,detailedPullRequestReviewComments :: Int + ,detailedPullRequestBase :: PullRequestCommit + ,detailedPullRequestCommits :: Int + ,detailedPullRequestMerged :: Bool + ,detailedPullRequestMergeable :: Bool +} deriving (Show, Data, Typeable, Eq, Ord) + +data PullRequestLinks = PullRequestLinks { + pullRequestLinksReviewComments :: String + ,pullRequestLinksComments :: String + ,pullRequestLinksHtml :: String + ,pullRequestLinksSelf :: String +} deriving (Show, Data, Typeable, Eq, Ord) + +data PullRequestCommit = PullRequestCommit { +} deriving (Show, Data, Typeable, Eq, Ord) + +data Repo = Repo { + repoSshUrl :: String + ,repoDescription :: String + ,repoCreatedAt :: GithubDate + ,repoHtmlUrl :: String + ,repoSvnUrl :: String + ,repoForks :: Int + ,repoHomepage :: Maybe String + ,repoFork :: Bool + ,repoGitUrl :: String + ,repoPrivate :: Bool + ,repoCloneUrl :: String + ,repoSize :: Int + ,repoUpdatedAt :: GithubDate + ,repoWatchers :: Int + ,repoOwner :: GithubUser + ,repoName :: String + ,repoLanguage :: String + ,repoMasterBranch :: Maybe String + ,repoPushedAt :: GithubDate + ,repoId :: Int + ,repoUrl :: String + ,repoOpenIssues :: Int + ,repoHasWiki :: Maybe Bool + ,repoHasIssues :: Maybe Bool + ,repoHasDownloads :: Maybe Bool +} 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 DetailedUser = DetailedUser { + detailedUserCreatedAt :: GithubDate + ,detailedUserType :: String + ,detailedUserPublicGists :: Int + ,detailedUserAvatarUrl :: String + ,detailedUserFollowers :: Int + ,detailedUserFollowing :: Int + ,detailedUserHireable :: Bool + ,detailedUserGravatarId :: String + ,detailedUserBlog :: Maybe String + ,detailedUserBio :: Maybe String + ,detailedUserPublicRepos :: Int + ,detailedUserName :: Maybe String + ,detailedUserLocation :: Maybe String + ,detailedUserCompany :: Maybe String + ,detailedUserEmail :: String + ,detailedUserUrl :: String + ,detailedUserId :: Int + ,detailedUserHtmlUrl :: String + ,detailedUserLogin :: String +} deriving (Show, Data, Typeable, Eq, Ord) diff --git a/Github/Gists.hs b/Github/Gists.hs new file mode 100644 --- /dev/null +++ b/Github/Gists.hs @@ -0,0 +1,21 @@ +-- | The gists API as described at . +module Github.Gists ( + gists +,gist +,module Github.Data +) where + +import Github.Data +import Github.Private + +-- | The list of all public gists created by the user. +-- +-- > gists "mike-burns" +gists :: String -> IO (Either Error [Gist]) +gists userName = githubGet ["users", userName, "gists"] + +-- | A specific gist, given its id. +-- +-- > gist "225074" +gist :: String -> IO (Either Error Gist) +gist gistId = githubGet ["gists", gistId] diff --git a/Github/Gists/Comments.hs b/Github/Gists/Comments.hs new file mode 100644 --- /dev/null +++ b/Github/Gists/Comments.hs @@ -0,0 +1,22 @@ +-- | The loving comments people have left on Gists, described on +-- . +module Github.Gists.Comments ( + commentsOn +,comment +,module Github.Data +) where + +import Github.Data +import Github.Private + +-- | All the comments on a Gist, given the Gist ID. +-- +-- > commentsOn "1174060" +commentsOn :: String -> IO (Either Error [GistComment]) +commentsOn gistId = githubGet ["gists", gistId, "comments"] + +-- | A specific comment, by the comment ID. +-- +-- > comment "62449" +comment :: String -> IO (Either Error GistComment) +comment commentId = githubGet ["gists", "comments", commentId] diff --git a/Github/GitData/Blobs.hs b/Github/GitData/Blobs.hs new file mode 100644 --- /dev/null +++ b/Github/GitData/Blobs.hs @@ -0,0 +1,16 @@ +-- | The API for dealing with git blobs from Github repos, as described in +-- . +module Github.GitData.Blobs ( + blob +,module Github.Data +) where + +import Github.Data +import Github.Private + +-- | Get a blob by SHA1. +-- +-- > blob "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" +blob :: String -> String -> String -> IO (Either Error Blob) +blob user repoName sha = + githubGet ["repos", user, repoName, "git", "blobs", sha] diff --git a/Github/GitData/Commits.hs b/Github/GitData/Commits.hs new file mode 100644 --- /dev/null +++ b/Github/GitData/Commits.hs @@ -0,0 +1,16 @@ +-- | The API for underlying git commits of a Github repo, as described on +-- . +module Github.GitData.Commits ( + commit +,module Github.Data +) where + +import Github.Data +import Github.Private + +-- | A single commit, by SHA1. +-- +-- > commit "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" +commit :: String -> String -> String -> IO (Either Error GitCommit) +commit user repoName sha = + githubGet ["repos", user, repoName, "git", "commits", sha] diff --git a/Github/GitData/References.hs b/Github/GitData/References.hs new file mode 100644 --- /dev/null +++ b/Github/GitData/References.hs @@ -0,0 +1,33 @@ +-- | The underlying git references on a Github repo, exposed for the world to +-- see. The git internals documentation will also prove handy for understanding +-- these. API documentation at . +module Github.GitData.References ( + reference +,references +,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 repoName ref = + githubGet ["repos", user, repoName, "git", "refs", ref] + +-- | The history of references for a repo. +-- +-- > references "mike-burns" "github" +references :: String -> String -> IO (Either Error [GitReference]) +references user repoName = + githubGet ["repos", user, repoName, "git", "refs"] + +-- | Limited references by a namespace. +-- +-- > namespacedReferences "thoughtbot" "paperclip" "tags" +namespacedReferences :: String -> String -> String -> IO (Either Error [GitReference]) +namespacedReferences user repoName namespace = + githubGet ["repos", user, repoName, "git", "refs", namespace] diff --git a/Github/GitData/Trees.hs b/Github/GitData/Trees.hs new file mode 100644 --- /dev/null +++ b/Github/GitData/Trees.hs @@ -0,0 +1,25 @@ +-- | The underlying tree of SHA1s and files that make up a git repo. The API is +-- described on . +module Github.GitData.Trees ( + tree +,nestedTree +,module Github.Data +) where + +import Github.Data +import Github.Private + +-- | A tree for a SHA1. +-- +-- > tree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" +tree :: String -> String -> String -> IO (Either Error Tree) +tree user repoName sha = + githubGet ["repos", user, repoName, "git", "trees", sha] + +-- | A recursively-nested tree for a SHA1. +-- +-- > nestedTree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" +nestedTree :: String -> String -> String -> IO (Either Error Tree) +nestedTree user repoName sha = + githubGetWithQueryString ["repos", user, repoName, "git", "trees", sha] + "recursive=1" diff --git a/Github/Issues.hs b/Github/Issues.hs new file mode 100644 --- /dev/null +++ b/Github/Issues.hs @@ -0,0 +1,66 @@ +-- | The issues API as described on . +module Github.Issues ( + issue +,issuesForRepo +,IssueLimitation(..) +,module Github.Data +) where + +import Github.Data +import Github.Private +import Data.List (intercalate) +import Data.Time.Format (formatTime) +import System.Locale (defaultTimeLocale) +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. + +-- | 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 user repoName issueNumber = + githubGet ["repos", user, repoName, "issues", show issueNumber] + +-- | 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 user repoName issueLimitations = + githubGetWithQueryString + ["repos", user, repoName, "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 (Since t) = + "since=" ++ formatTime defaultTimeLocale "%FT%TZ" t diff --git a/Github/Issues/Comments.hs b/Github/Issues/Comments.hs new file mode 100644 --- /dev/null +++ b/Github/Issues/Comments.hs @@ -0,0 +1,24 @@ +-- | The Github issue comments API from +-- . +module Github.Issues.Comments ( + comment +,comments +,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 repoName commentId = + githubGet ["repos", user, repoName, "issues", "comments", show commentId] + +-- | All comments on an issue, by the issue's number. +-- +-- > comments "thoughtbot" "paperclip" 635 +comments :: String -> String -> Int -> IO (Either Error [IssueComment]) +comments user repoName issueNumber = + githubGet ["repos", user, repoName, "issues", show issueNumber, "comments"] diff --git a/Github/Issues/Events.hs b/Github/Issues/Events.hs new file mode 100644 --- /dev/null +++ b/Github/Issues/Events.hs @@ -0,0 +1,32 @@ +-- | The Github issue events API, which is described on +-- +module Github.Issues.Events ( + eventsForIssue +,eventsForRepo +,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 repoName issueNumber = + githubGet ["repos", user, repoName, "issues", show issueNumber, "events"] + +-- | All the events for all issues in a repo. +-- +-- > eventsForRepo "thoughtbot" "paperclip" +eventsForRepo :: String -> String -> IO (Either Error [Event]) +eventsForRepo user repoName = + githubGet ["repos", user, repoName, "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 repoName eventId = + githubGet ["repos", user, repoName, "issues", "events", show eventId] diff --git a/Github/Issues/Labels.hs b/Github/Issues/Labels.hs new file mode 100644 --- /dev/null +++ b/Github/Issues/Labels.hs @@ -0,0 +1,39 @@ +-- | The API for dealing with labels on Github issues, as described on +-- . +module Github.Issues.Labels ( + label +,labelsOnRepo +,labelsOnIssue +,labelsOnMilestone +,module Github.Data +) where + +import Github.Data +import Github.Private + +-- | All the labels available to use on any issue in the repo. +-- +-- > labelsOnRepo "thoughtbot" "paperclip" +labelsOnRepo :: String -> String -> IO (Either Error [IssueLabel]) +labelsOnRepo user repoName = githubGet ["repos", user, repoName, "labels"] + +-- | The labels on an issue in a repo. +-- +-- > labelsOnIssue "thoughtbot" "paperclip" 585 +labelsOnIssue :: String -> String -> Int -> IO (Either Error [IssueLabel]) +labelsOnIssue user repoName issueId = + githubGet ["repos", user, repoName, "issues", show issueId, "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 repoName milestoneId = + githubGet ["repos", user, repoName, "milestones", show milestoneId, "labels"] + +-- | A label, by name. +-- +-- > Github.label "thoughtbot" "paperclip" "bug" +label :: String -> String -> String -> IO (Either Error IssueLabel) +label user repoName labelName = + githubGet ["repos", user, repoName, "labels", labelName] diff --git a/Github/Issues/Milestones.hs b/Github/Issues/Milestones.hs new file mode 100644 --- /dev/null +++ b/Github/Issues/Milestones.hs @@ -0,0 +1,23 @@ +-- | The milestones API as described on +-- . +module Github.Issues.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 user repoName = githubGet ["repos", user, repoName, "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 repoName milestoneNumber = + githubGet ["repos", user, repoName, "milestones", show milestoneNumber] diff --git a/Github/Organizations.hs b/Github/Organizations.hs new file mode 100644 --- /dev/null +++ b/Github/Organizations.hs @@ -0,0 +1,21 @@ +-- | The orgs API as described on . +module Github.Organizations ( + publicOrganizationsFor +,publicOrganization +,module Github.Data +) where + +import Github.Data +import Github.Private + +-- | The public organizations for a user, given the user's login. +-- +-- > publicOrganizationsFor "mike-burns" +publicOrganizationsFor :: String -> IO (Either Error [SimpleOrganization]) +publicOrganizationsFor userName = githubGet ["users", userName, "orgs"] + +-- | Details on a public organization. Takes the organization's login. +-- +-- > publicOrganization "thoughtbot" +publicOrganization :: String -> IO (Either Error Organization) +publicOrganization organizationName = githubGet ["orgs", organizationName] diff --git a/Github/Organizations/Members.hs b/Github/Organizations/Members.hs new file mode 100644 --- /dev/null +++ b/Github/Organizations/Members.hs @@ -0,0 +1,15 @@ +-- | The organization members API as described on +-- . +module Github.Organizations.Members ( + membersOf +,module Github.Data +) where + +import Github.Data +import Github.Private + +-- | All the users who are members of the specified organization. +-- +-- > membersOf "thoughtbot" +membersOf :: String -> IO (Either Error [GithubUser]) +membersOf organization = githubGet ["orgs", organization, "members"] diff --git a/Github/Private.hs b/Github/Private.hs new file mode 100644 --- /dev/null +++ b/Github/Private.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE OverloadedStrings, StandaloneDeriving #-} +module Github.Private where + +import Github.Data +import Data.Aeson +import Data.Attoparsec +import Control.Applicative +import Data.List +import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString.Lazy.Char8 as LBS +import qualified Network.HTTP.Types as Types +import Network.HTTP.Enumerator +import Text.URI +import Control.Failure hiding (Error(..)) +import qualified Control.Exception as E +import Data.Maybe (fromMaybe) + +githubGet :: (FromJSON b, Show b) => [String] -> IO (Either Error b) +githubGet paths = + githubAPI (BS.pack "GET") + (buildUrl paths) + (Nothing :: Maybe Value) + +githubGetWithQueryString :: (FromJSON b, Show b) => [String] -> String -> IO (Either Error b) +githubGetWithQueryString paths queryString = + githubAPI (BS.pack "GET") + (buildUrl paths ++ "?" ++ queryString) + (Nothing :: Maybe Value) + +buildUrl :: [String] -> String +buildUrl paths = "https://api.github.com/" ++ intercalate "/" paths + +githubAPI :: (ToJSON a, Show a, FromJSON b, Show b) => BS.ByteString -> String -> Maybe a -> IO (Either Error b) +githubAPI method url body = do + result <- doHttps method url (Just encodedBody) + return $ either (Left . HTTPConnectionError) + (parseJson . BS.pack . LBS.unpack . responseBody) + result + where encodedBody = RequestBodyLBS $ encode $ toJSON body + +parseJson :: (FromJSON b, Show b) => BS.ByteString -> Either Error b +parseJson jsonString = + let parsed = parse (fromJSON <$> json) jsonString in + case parsed of + Data.Attoparsec.Done _ jsonResult -> do + case jsonResult of + (Success s) -> Right s + (Error e) -> Left $ JsonError $ e ++ " on the JSON: " ++ BS.unpack jsonString + (Fail _ _ e) -> Left $ ParseError e + +doHttps :: BS.ByteString -> String -> Maybe (RequestBody IO) -> IO (Either E.IOException Response) +doHttps method url body = do + let (Just uri) = parseURI url + (Just host) = uriRegName uri + requestBody = fromMaybe (RequestBodyBS $ BS.pack "") body + queryString = Types.parseQuery $ BS.pack $ fromMaybe "" $ uriQuery uri + request = def { method = method + , secure = True + , host = BS.pack host + , port = 443 + , path = BS.pack $ uriPath uri + , requestBody = requestBody + , queryString = queryString + } + + (getResponse request >>= return . Right) `catch` (return . Left) + where + getResponse request = withManager $ \manager -> httpLbs request manager diff --git a/Github/PullRequests.hs b/Github/PullRequests.hs new file mode 100644 --- /dev/null +++ b/Github/PullRequests.hs @@ -0,0 +1,43 @@ +-- | The pull requests API as documented at +-- . +module Github.PullRequests ( + pullRequestsFor +,pullRequest +,pullRequestCommits +,pullRequestFiles +,module Github.Data +) where + +import Github.Data +import Github.Private + +-- | All pull requests for the repo, by owner and repo name. +-- +-- > pullRequestsFor "rails" "rails" +pullRequestsFor :: String -> String -> IO (Either Error [PullRequest]) +pullRequestsFor userName repoName = + githubGet ["repos", userName, repoName, "pulls"] + +-- | 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 userName repoName number = + githubGet ["repos", userName, repoName, "pulls", show number] + +-- | 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 userName repoName number = + githubGet ["repos", userName, repoName, "pulls", show number, "commits"] + +-- | 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 userName repoName number = + githubGet ["repos", userName, repoName, "pulls", show number, "files"] diff --git a/Github/Repos.hs b/Github/Repos.hs new file mode 100644 --- /dev/null +++ b/Github/Repos.hs @@ -0,0 +1,96 @@ +-- | The Github Repos API, as documented at +-- +module Github.Repos ( + userRepos +,organizationRepos +,userRepo +,contributors +,contributorsWithAnonymous +,languagesFor +,tagsFor +,branchesFor +,module Github.Data +,RepoPublicity(..) +) where + +import Github.Data +import Github.Private + +-- | 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 userName All = + githubGetWithQueryString ["users", userName, "repos"] "type=all" +userRepos userName Owner = + githubGetWithQueryString ["users", userName, "repos"] "type=owner" +userRepos userName Member = + githubGetWithQueryString ["users", userName, "repos"] "type=member" +userRepos userName Public = + githubGetWithQueryString ["users", userName, "repos"] "type=public" +userRepos 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 orgName = githubGet ["orgs", orgName, "repos"] + +-- | Details on a specific repo, given the owner and repo name. +-- +-- > userRepo "mike-burns" "github" +userRepo :: String -> String -> IO (Either Error Repo) +userRepo userName repoName = githubGet ["repos", userName, repoName] + +-- | The contributors to a repo, given the owner and repo name. +-- +-- > contributors "thoughtbot" "paperclip" +contributors :: String -> String -> IO (Either Error [Contributor]) +contributors userName repoName = + githubGet ["repos", userName, repoName, "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 userName repoName = + githubGetWithQueryString + ["repos", userName, repoName, "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 userName repoName = do + result <- githubGet ["repos", userName, repoName, "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 userName repoName = + githubGet ["repos", userName, repoName, "tags"] + +-- | The git branches on a repo, given the repo owner and name. +-- +-- > branchesFor "thoughtbot" "paperclip" +branchesFor :: String -> String -> IO (Either Error [Branch]) +branchesFor userName repoName = + githubGet ["repos", userName, repoName, "branches"] diff --git a/Github/Repos/Collaborators.hs b/Github/Repos/Collaborators.hs new file mode 100644 --- /dev/null +++ b/Github/Repos/Collaborators.hs @@ -0,0 +1,34 @@ +-- | The repo collaborators API as described on +-- . +module Github.Repos.Collaborators ( + collaboratorsOn +,isCollaboratorOn +,module Github.Data +) where + +import Github.Data +import Github.Private + +import Data.ByteString.Char8 (pack) +import Network.HTTP.Enumerator (statusCode) + +-- | All the users who have collaborated on a repo. +-- +-- > collaboratorsOn "thoughtbot" "paperclip" +collaboratorsOn :: String -> String -> IO (Either Error [GithubUser]) +collaboratorsOn userName repoName = + githubGet ["repos", userName, repoName, "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 repoName = do + result <- doHttps (pack "GET") + (buildUrl ["repos", repoOwnerName, repoName, "collaborators", userName]) + Nothing + return $ either (Left . HTTPConnectionError) + (Right . (204 ==) . statusCode) + result diff --git a/Github/Repos/Commits.hs b/Github/Repos/Commits.hs new file mode 100644 --- /dev/null +++ b/Github/Repos/Commits.hs @@ -0,0 +1,53 @@ +-- | The repo commits API as described on +-- . +module Github.Repos.Commits ( + commitsFor +,commit +,commentsFor +,commitCommentsFor +,commitCommentFor +,diff +,module Github.Data +) where + +import Github.Data +import Github.Private + +-- | The commit history for a repo. +-- +-- > commitsFor "mike-burns" "github" +commitsFor :: String -> String -> IO (Either Error [Commit]) +commitsFor user repo = githubGet ["repos", user, repo, "commits"] + +-- | Details on a specific SHA1 for a repo. +-- +-- > commit "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81" +commit :: String -> String -> String -> IO (Either Error Commit) +commit user repo sha1 = githubGet ["repos", user, repo, "commits", sha1] + +-- | All the comments on a Github repo. +-- +-- > commentsFor "thoughtbot" "paperclip" +commentsFor :: String -> String -> IO (Either Error [Comment]) +commentsFor user repo = githubGet ["repos", user, repo, "comments"] + +-- | Just the comments on a specific SHA for a given Github repo. +-- +-- > commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" +commitCommentsFor :: String -> String -> String -> IO (Either Error [Comment]) +commitCommentsFor user repo sha1 = + githubGet ["repos", user, repo, "commits", sha1, "comments"] + +-- | A comment, by its ID, relative to the Github repo. +-- +-- > commitCommentFor "thoughtbot" "paperclip" "669575" +commitCommentFor :: String -> String -> String -> IO (Either Error Comment) +commitCommentFor user repo commentId = + githubGet ["repos", user, repo, "comments", commentId] + +-- | 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 head = + githubGet ["repos", user, repo, "compare", base ++ "..." ++ head] diff --git a/Github/Repos/Forks.hs b/Github/Repos/Forks.hs new file mode 100644 --- /dev/null +++ b/Github/Repos/Forks.hs @@ -0,0 +1,16 @@ +-- | Hot forking action, as described at +-- . +module Github.Repos.Forks ( + 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 userName repoName = + githubGet ["repos", userName, repoName, "forks"] diff --git a/Github/Repos/Watching.hs b/Github/Repos/Watching.hs new file mode 100644 --- /dev/null +++ b/Github/Repos/Watching.hs @@ -0,0 +1,23 @@ +-- | The repo watching API as described on +-- . +module Github.Repos.Watching ( + watchersFor +,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 [GithubUser]) +watchersFor userName repoName = + githubGet ["repos", userName, repoName, "watchers"] + +-- | All the public repos watched by the specified user. +-- +-- > reposWatchedBy "croaky" +reposWatchedBy :: String -> IO (Either Error [Repo]) +reposWatchedBy userName = githubGet ["users", userName, "watched"] diff --git a/Github/Users.hs b/Github/Users.hs new file mode 100644 --- /dev/null +++ b/Github/Users.hs @@ -0,0 +1,15 @@ +-- | The Github Users API, as described at +-- . +module Github.Users ( + userInfoFor +,module Github.Data +) where + +import Github.Data +import Github.Private + +-- | The information for a single user, by login name. +-- +-- > userInfoFor "mike-burns" +userInfoFor :: String -> IO (Either Error DetailedUser) +userInfoFor userName = githubGet ["users", userName] diff --git a/Github/Users/Followers.hs b/Github/Users/Followers.hs new file mode 100644 --- /dev/null +++ b/Github/Users/Followers.hs @@ -0,0 +1,22 @@ +-- | The user followers API as described on +-- . +module Github.Users.Followers ( + usersFollowing +,usersFollowedBy +,module Github.Data +) where + +import Github.Data +import Github.Private + +-- | All the users following the given user. +-- +-- > usersFollowing "mike-burns" +usersFollowing :: String -> IO (Either Error [GithubUser]) +usersFollowing userName = githubGet ["users", userName, "followers"] + +-- | All the users that the given user follows. +-- +-- > usersFollowedBy "mike-burns" +usersFollowedBy :: String -> IO (Either Error [GithubUser]) +usersFollowedBy userName = githubGet ["users", userName, "following"] diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c)2011, ??? + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of ??? nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,57 @@ +Github +------ + +The Github API v3 for Haskell. + +**This is currently a read-only API.** There is a `read-write` branch with +ideas on how this can work for writing to Github, but I need ideas on how +authentication should work. *You can help* if you [let me +know](mailto:mike@mike-burns.com) how you are using this library or how you +would like to use it, and which authentication method is best for you (HTTP +basic, OAuth). + +Some functions which do not require authentication are also missing; these are functions where the Github API did not work as expected. The full Github API is in beta and constantly improving. + +Installation +============ + +In your project's cabal file: + + -- Packages needed in order to build this package. + Build-depends: github + +Or from the command line: + + cabal install github + +Example Usage +============= + +See the samples in the [samples/](https://github.com/mike-burns/github/tree/master/samples) directory. + +Documentation +============= + +For details see the reference documentation on Hackage. Later. + +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. + +All 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 Github.Users.Followers + import Data.List (intercalate) + main = do + possibleUsers <- usersFollowing "mike-burns" + putStrLn $ either (\error -> "Error: " ++ $ show error) + (intercalate "\n" . map githubUserLogin) + possibleUsers + + +Copyright +========= + +Copyright 2011 Mike Burns. + +Available under the BSD 3-clause license. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/github.cabal b/github.cabal new file mode 100644 --- /dev/null +++ b/github.cabal @@ -0,0 +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.1 + +-- 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. + +-- 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 + +-- An email address to which users can send suggestions, bug reports, +-- and patches. +Maintainer: mike@mike-burns.com + +-- A copyright notice. +Copyright: Copyright 2011 Mike Burns + +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/Blobs/GitHashObject.hs + ,samples/GitData/Commits/GitShow.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/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/Users/Followers/ListFollowers.hs + ,samples/Users/Followers/ListFollowing.hs + ,samples/Users/ShowUser.hs + ,LICENSE + + +-- Constraint on the version of Cabal needed to build this package. +Cabal-version: >=1.6 + +source-repository head + type: git + location: git://github.com/mike-burns/github.git + + +Library + -- Modules exported by the library. + Exposed-modules: Github.Data, + Github.Data.Definitions, + + Github.Gists, + Github.Gists.Comments, + Github.GitData.Blobs, + Github.GitData.Commits, + Github.GitData.References, + Github.GitData.Trees, + 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.Users, + Github.Users.Followers + + + -- Packages needed in order to build this package. + Build-depends: base >= 4.0 && < 5.0, + time, + aeson, + attoparsec, + bytestring, + containers, + text, + old-locale, + HTTP, + network, + http-enumerator, + uri, + failure, + http-types, + vector + + -- Modules not exported by this package. + Other-modules: Github.Private + + -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. + -- Build-tools: + diff --git a/samples/Gists/Comments/ShowComment.hs b/samples/Gists/Comments/ShowComment.hs new file mode 100644 --- /dev/null +++ b/samples/Gists/Comments/ShowComment.hs @@ -0,0 +1,16 @@ +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.githubUserLogin $ Github.gistCommentUser comment) ++ "\n" ++ + (formatGithubDate $ Github.gistCommentUpdatedAt comment) ++ "\n\n" ++ + (Github.gistCommentBody comment) + +formatGithubDate = show . Github.fromGithubDate diff --git a/samples/Gists/Comments/ShowComments.hs b/samples/Gists/Comments/ShowComments.hs new file mode 100644 --- /dev/null +++ b/samples/Gists/Comments/ShowComments.hs @@ -0,0 +1,17 @@ +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.githubUserLogin $ Github.gistCommentUser comment) ++ "\n" ++ + (formatGithubDate $ Github.gistCommentUpdatedAt comment) ++ "\n\n" ++ + (Github.gistCommentBody comment) + +formatGithubDate = show . Github.fromGithubDate diff --git a/samples/Gists/ListGists.hs b/samples/Gists/ListGists.hs new file mode 100644 --- /dev/null +++ b/samples/Gists/ListGists.hs @@ -0,0 +1,15 @@ +module ListGists where + +import qualified Github.Gists as Github +import Data.List (intercalate) + +main = do + possibleGists <- Github.gists "mike-burns" + case possibleGists of + (Left error) -> putStrLn $ "Error: " ++ (show error) + (Right gists) -> putStrLn $ intercalate "\n\n" $ map formatGist gists + +formatGist gist = + (Github.gistId gist) ++ "\n" ++ + (maybe "indescribable" id $ Github.gistDescription gist) ++ "\n" ++ + (Github.gistHtmlUrl gist) diff --git a/samples/Gists/ShowGist.hs b/samples/Gists/ShowGist.hs new file mode 100644 --- /dev/null +++ b/samples/Gists/ShowGist.hs @@ -0,0 +1,20 @@ +module ShowGist where + +import qualified Github.Gists as Github +import Data.List (intercalate) + +main = do + possibleGist <- Github.gist "23084" + case possibleGist of + (Left error) -> putStrLn $ "Error: " ++ (show error) + (Right gist) -> putStrLn $ formatGist gist + +formatGist gist = + (Github.gistId gist) ++ "\n" ++ + (maybe "indescribable" id $ Github.gistDescription gist) ++ "\n" ++ + (Github.gistHtmlUrl gist) ++ "\n\n" ++ + (intercalate "\n\n" $ map formatGistFile $ Github.gistFiles gist) + +formatGistFile gistFile = + (Github.gistFileFilename gistFile) ++ ":\n" ++ + maybe "[empty]" id (Github.gistFileContent gistFile) diff --git a/samples/GitData/Blobs/GitHashObject.hs b/samples/GitData/Blobs/GitHashObject.hs new file mode 100644 --- /dev/null +++ b/samples/GitData/Blobs/GitHashObject.hs @@ -0,0 +1,10 @@ +module GitHashObject where + +import qualified Github.GitData.Blobs as Github +import Data.List( intercalate) + +main = do + possibleBlob <- Github.blob "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" + case possibleBlob of + (Left error) -> putStrLn $ "Error: " ++ (show error) + (Right blob) -> putStrLn $ Github.blobContent blob diff --git a/samples/GitData/Commits/GitShow.hs b/samples/GitData/Commits/GitShow.hs new file mode 100644 --- /dev/null +++ b/samples/GitData/Commits/GitShow.hs @@ -0,0 +1,23 @@ +module GitShow where + +import qualified Github.GitData.Commits as Github +import Data.Maybe (fromJust) + +main = do + possibleCommit <- Github.commit "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" + case possibleCommit of + (Left error) -> putStrLn $ "Error: " ++ (show error) + (Right commit) -> putStrLn $ formatCommit commit + +formatCommit :: Github.GitCommit -> String +formatCommit commit = + "commit " ++ (fromJust $ Github.gitCommitSha commit) ++ + "\nAuthor: " ++ (formatAuthor author) ++ + "\nDate: " ++ (show $ Github.fromGithubDate $ Github.gitUserDate author) ++ + "\n\n\t" ++ (Github.gitCommitMessage commit) ++ "\n" + where author = Github.gitCommitAuthor commit + +formatAuthor :: Github.GitUser -> String +formatAuthor author = + (Github.gitUserName author) ++ " <" ++ (Github.gitUserEmail author) ++ ">" + diff --git a/samples/GitData/References/GitLsRemote.hs b/samples/GitData/References/GitLsRemote.hs new file mode 100644 --- /dev/null +++ b/samples/GitData/References/GitLsRemote.hs @@ -0,0 +1,16 @@ +module GitLsRemote where + +import qualified Github.GitData.References as Github +import Data.List (intercalate) + +main = do + possibleReferences <- Github.references "mike-burns" "github" + case possibleReferences of + (Left error) -> putStrLn $ "Error: " ++ show error + (Right references) -> do + putStrLn "From git@github.com:mike-burns/github.git" + putStrLn $ intercalate "\n" $ map formatReference references + +formatReference reference = + (Github.gitObjectSha $ Github.gitReferenceObject reference) ++ + "\t" ++ (Github.gitReferenceRef reference) diff --git a/samples/GitData/References/GitLsRemoteTags.hs b/samples/GitData/References/GitLsRemoteTags.hs new file mode 100644 --- /dev/null +++ b/samples/GitData/References/GitLsRemoteTags.hs @@ -0,0 +1,17 @@ +module GitLsRemoteTags where + +import qualified Github.GitData.References as Github +import Data.List (intercalate) + +main = do + possibleReferences <- Github.namespacedReferences "thoughtbot" "paperclip" "tags" + case possibleReferences of + (Left error) -> putStrLn $ "Error: " ++ show error + (Right references) -> do + putStrLn "From git@github.com:thoughtbot/paperclip.git" + putStrLn $ intercalate "\n" $ map formatReference references + +formatReference reference = + (Github.gitObjectSha $ Github.gitReferenceObject reference) ++ + "\t" ++ (Github.gitReferenceRef reference) + diff --git a/samples/GitData/References/GitLsRemoteWithRef.hs b/samples/GitData/References/GitLsRemoteWithRef.hs new file mode 100644 --- /dev/null +++ b/samples/GitData/References/GitLsRemoteWithRef.hs @@ -0,0 +1,13 @@ +module GitLsRemoteWithRef where + +import qualified Github.GitData.References as Github + +main = do + possibleReference <- Github.reference "mike-burns" "github" "heads/master" + putStrLn $ either (\e -> "Error: " ++ show e) + formatReference + possibleReference + +formatReference reference = + (Github.gitObjectSha $ Github.gitReferenceObject reference) ++ + "\t" ++ (Github.gitReferenceRef reference) diff --git a/samples/GitData/Trees/GitLsTree.hs b/samples/GitData/Trees/GitLsTree.hs new file mode 100644 --- /dev/null +++ b/samples/GitData/Trees/GitLsTree.hs @@ -0,0 +1,19 @@ +module GitLsTree where + +import qualified Github.GitData.Trees as Github +import Data.List (intercalate) + +main = do + possibleTree <- Github.tree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" + case possibleTree of + (Left error) -> putStrLn $ "Error: " ++ show error + (Right tree) -> putStrLn $ formatTree tree + +formatTree tree = + intercalate "\n" $ map formatGitTree $ Github.treeGitTrees tree + +formatGitTree gitTree = + (Github.gitTreeMode gitTree) ++ " " ++ + (Github.gitTreeType gitTree) ++ " " ++ + (Github.gitTreeSha gitTree) ++ "\t" ++ + (Github.gitTreePath gitTree) diff --git a/samples/GitData/Trees/GitLsTreeRecursively.hs b/samples/GitData/Trees/GitLsTreeRecursively.hs new file mode 100644 --- /dev/null +++ b/samples/GitData/Trees/GitLsTreeRecursively.hs @@ -0,0 +1,19 @@ +module GitLsTreeRecursively where + +import qualified Github.GitData.Trees as Github +import Data.List (intercalate) + +main = do + possibleTree <- Github.nestedTree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" + case possibleTree of + (Left error) -> putStrLn $ "Error: " ++ show error + (Right tree) -> putStrLn $ formatTree tree + +formatTree tree = + intercalate "\n" $ map formatGitTree $ Github.treeGitTrees tree + +formatGitTree gitTree = + (Github.gitTreeMode gitTree) ++ " " ++ + (Github.gitTreeType gitTree) ++ " " ++ + (Github.gitTreeSha gitTree) ++ "\t" ++ + (Github.gitTreePath gitTree) diff --git a/samples/Issues/Comments/ShowComment.hs b/samples/Issues/Comments/ShowComment.hs new file mode 100644 --- /dev/null +++ b/samples/Issues/Comments/ShowComment.hs @@ -0,0 +1,15 @@ +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.githubUserLogin $ Github.issueCommentUser comment) ++ + " commented " ++ + (show $ Github.fromGithubDate $ Github.issueCommentUpdatedAt comment) ++ + "\n" ++ (Github.issueCommentBody comment) diff --git a/samples/Issues/Comments/ShowComments.hs b/samples/Issues/Comments/ShowComments.hs new file mode 100644 --- /dev/null +++ b/samples/Issues/Comments/ShowComments.hs @@ -0,0 +1,17 @@ +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.githubUserLogin $ Github.issueCommentUser comment) ++ + " commented " ++ + (show $ Github.fromGithubDate $ Github.issueCommentUpdatedAt comment) ++ + "\n" ++ (Github.issueCommentBody comment) diff --git a/samples/Issues/Events/ShowEvent.hs b/samples/Issues/Events/ShowEvent.hs new file mode 100644 --- /dev/null +++ b/samples/Issues/Events/ShowEvent.hs @@ -0,0 +1,38 @@ +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.githubUserLogin . Github.eventActor +createdAt = show . Github.fromGithubDate . Github.eventCreatedAt +withCommitId event f = maybe "" f (Github.eventCommitId event) diff --git a/samples/Issues/Events/ShowIssueEvents.hs b/samples/Issues/Events/ShowIssueEvents.hs new file mode 100644 --- /dev/null +++ b/samples/Issues/Events/ShowIssueEvents.hs @@ -0,0 +1,38 @@ +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.githubUserLogin . Github.eventActor +createdAt = show . Github.fromGithubDate . Github.eventCreatedAt +withCommitId event f = maybe "" f (Github.eventCommitId event) diff --git a/samples/Issues/Events/ShowRepoEvents.hs b/samples/Issues/Events/ShowRepoEvents.hs new file mode 100644 --- /dev/null +++ b/samples/Issues/Events/ShowRepoEvents.hs @@ -0,0 +1,41 @@ +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.githubUserLogin . Github.eventActor +createdAt = show . Github.fromGithubDate . Github.eventCreatedAt +withCommitId event f = maybe "" f (Github.eventCommitId event) +issueNumber = show . Github.issueNumber . fromJust . Github.eventIssue diff --git a/samples/Issues/Labels/ShowIssueLabels.hs b/samples/Issues/Labels/ShowIssueLabels.hs new file mode 100644 --- /dev/null +++ b/samples/Issues/Labels/ShowIssueLabels.hs @@ -0,0 +1,14 @@ +module ShowIssueLabels where + +import qualified Github.Issues.Labels as Github +import Data.List (intercalate) + +main = do + possibleLabels <- Github.labelsOnIssue "thoughtbot" "paperclip" 585 + case possibleLabels of + (Left error) -> putStrLn $ "Error: " ++ show error + (Right labels) -> do + putStrLn $ intercalate "\n" $ map formatLabel labels + +formatLabel label = + (Github.labelName label) ++ ", colored " ++ (Github.labelColor label) diff --git a/samples/Issues/Labels/ShowLabel.hs b/samples/Issues/Labels/ShowLabel.hs new file mode 100644 --- /dev/null +++ b/samples/Issues/Labels/ShowLabel.hs @@ -0,0 +1,13 @@ +module ShowLabel where + +import qualified Github.Issues.Labels as Github + +main = do + possibleLabel <- Github.label "thoughtbot" "paperclip" "bug" + case possibleLabel of + (Left error) -> putStrLn $ "Error: " ++ show error + (Right label) -> putStrLn $ formatLabel label + +formatLabel label = + (Github.labelName label) ++ ", colored " ++ (Github.labelColor label) + diff --git a/samples/Issues/Labels/ShowMilestoneLabels.hs b/samples/Issues/Labels/ShowMilestoneLabels.hs new file mode 100644 --- /dev/null +++ b/samples/Issues/Labels/ShowMilestoneLabels.hs @@ -0,0 +1,15 @@ +module ShowMilestoneLabels where + +import qualified Github.Issues.Labels as Github +import Data.List (intercalate) + +main = do + possibleLabels <- Github.labelsOnMilestone "thoughtbot" "paperclip" 2 + case possibleLabels of + (Left error) -> putStrLn $ "Error: " ++ show error + (Right labels) -> do + putStrLn $ intercalate "\n" $ map formatLabel labels + +formatLabel label = + (Github.labelName label) ++ ", colored " ++ (Github.labelColor label) + diff --git a/samples/Issues/Labels/ShowRepoLabels.hs b/samples/Issues/Labels/ShowRepoLabels.hs new file mode 100644 --- /dev/null +++ b/samples/Issues/Labels/ShowRepoLabels.hs @@ -0,0 +1,14 @@ +module ShowRepoLabels where + +import qualified Github.Issues.Labels as Github +import Data.List (intercalate) + +main = do + possibleLabels <- Github.labelsOnRepo "thoughtbot" "paperclip" + case possibleLabels of + (Left error) -> putStrLn $ "Error: " ++ show error + (Right labels) -> do + putStrLn $ intercalate "\n" $ map formatLabel labels + +formatLabel label = + (Github.labelName label) ++ ", colored " ++ (Github.labelColor label) diff --git a/samples/Issues/Milestones/ShowMilestone.hs b/samples/Issues/Milestones/ShowMilestone.hs new file mode 100644 --- /dev/null +++ b/samples/Issues/Milestones/ShowMilestone.hs @@ -0,0 +1,22 @@ +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) ++ + ", is due on " ++ (dueOn milestone) ++ " and has the " ++ + (Github.milestoneState milestone) ++ " status" + +loginName = Github.githubUserLogin . Github.milestoneCreator +createdAt = show . Github.fromGithubDate . Github.milestoneCreatedAt +dueOn = show . Github.fromGithubDate . Github.milestoneDueOn + diff --git a/samples/Issues/Milestones/ShowMilestones.hs b/samples/Issues/Milestones/ShowMilestones.hs new file mode 100644 --- /dev/null +++ b/samples/Issues/Milestones/ShowMilestones.hs @@ -0,0 +1,21 @@ +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) ++ + ", is due on " ++ (dueOn milestone) ++ " and has the " ++ + (Github.milestoneState milestone) ++ " status" + +loginName = Github.githubUserLogin . Github.milestoneCreator +createdAt = show . Github.fromGithubDate . Github.milestoneCreatedAt +dueOn = show . Github.fromGithubDate . Github.milestoneDueOn diff --git a/samples/Issues/ShowIssue.hs b/samples/Issues/ShowIssue.hs new file mode 100644 --- /dev/null +++ b/samples/Issues/ShowIssue.hs @@ -0,0 +1,17 @@ +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.githubUserLogin $ Github.issueUser issue) ++ + " opened this issue " ++ + (show $ Github.fromGithubDate $ Github.issueCreatedAt issue) ++ "\n" ++ + (Github.issueState issue) ++ " with " ++ + (show $ Github.issueComments issue) ++ " comments" ++ "\n\n" ++ + (Github.issueTitle issue) diff --git a/samples/Issues/ShowRepoIssues.hs b/samples/Issues/ShowRepoIssues.hs new file mode 100644 --- /dev/null +++ b/samples/Issues/ShowRepoIssues.hs @@ -0,0 +1,21 @@ +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.githubUserLogin $ Github.issueUser issue) ++ + " opened this issue " ++ + (show $ Github.fromGithubDate $ Github.issueCreatedAt issue) ++ "\n" ++ + (Github.issueState issue) ++ " with " ++ + (show $ Github.issueComments issue) ++ " comments" ++ "\n\n" ++ + (Github.issueTitle issue) + diff --git a/samples/Organizations/Members/ShowMembers.hs b/samples/Organizations/Members/ShowMembers.hs new file mode 100644 --- /dev/null +++ b/samples/Organizations/Members/ShowMembers.hs @@ -0,0 +1,11 @@ +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.githubUserLogin members diff --git a/samples/Organizations/ShowPublicOrganization.hs b/samples/Organizations/ShowPublicOrganization.hs new file mode 100644 --- /dev/null +++ b/samples/Organizations/ShowPublicOrganization.hs @@ -0,0 +1,15 @@ +module ShowPublicOrganization where + +import qualified Github.Organizations as Github + +main = do + possibleOrganization <- Github.publicOrganization "thoughtbot" + case possibleOrganization of + (Left error) -> putStrLn $ "Error: " ++ (show error) + (Right organization) -> + putStrLn $ formatOrganization organization + +formatOrganization organization = + (maybe "" (\s -> s ++ "\n") (Github.organizationName organization)) ++ + (Github.organizationHtmlUrl organization) ++ + (maybe "" (\s -> "\n" ++ s) (Github.organizationBlog organization)) diff --git a/samples/Organizations/ShowPublicOrganizations.hs b/samples/Organizations/ShowPublicOrganizations.hs new file mode 100644 --- /dev/null +++ b/samples/Organizations/ShowPublicOrganizations.hs @@ -0,0 +1,13 @@ +module ShowPublicOrganizations where + +import qualified Github.Organizations as Github +import Data.List (intercalate) + +main = do + possibleOrganizations <- Github.publicOrganizationsFor "mike-burns" + case possibleOrganizations of + (Left error) -> putStrLn $ "Error: " ++ (show error) + (Right organizations) -> + putStrLn $ intercalate "\n" $ map formatOrganization organizations + +formatOrganization = Github.simpleOrganizationLogin diff --git a/samples/Pulls/Diff.hs b/samples/Pulls/Diff.hs new file mode 100644 --- /dev/null +++ b/samples/Pulls/Diff.hs @@ -0,0 +1,13 @@ +module Diff where + +import qualified Github.PullRequests as Github +import Data.List + +main = do + possiblePullRequestFiles <- Github.pullRequestFiles "thoughtbot" "paperclip" 575 + case possiblePullRequestFiles of + (Left error) -> putStrLn $ "Error: " ++ (show error) + (Right files) -> putStrLn $ intercalate "\n\n" $ map formatFile files + +formatFile file = + Github.fileFilename file ++ "\n" ++ Github.filePatch file diff --git a/samples/Pulls/ListPulls.hs b/samples/Pulls/ListPulls.hs new file mode 100644 --- /dev/null +++ b/samples/Pulls/ListPulls.hs @@ -0,0 +1,23 @@ +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.githubUserLogin $ Github.pullRequestUser pullRequest) ++ + " submitted to thoughtbot/paperclip " ++ + (formatGithubDate $ Github.pullRequestCreatedAt pullRequest) ++ + " updated " ++ + (formatGithubDate $ Github.pullRequestUpdatedAt pullRequest) ++ "\n" ++ + (Github.pullRequestHtmlUrl pullRequest) + +formatGithubDate = show . Github.fromGithubDate diff --git a/samples/Pulls/ReviewComments/ListComments.hs b/samples/Pulls/ReviewComments/ListComments.hs new file mode 100644 --- /dev/null +++ b/samples/Pulls/ReviewComments/ListComments.hs @@ -0,0 +1,21 @@ +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.GithubUser -> String +formatAuthor user = + (Github.githubUserLogin user) ++ " (" ++ (Github.githubUserUrl user) ++ ")" diff --git a/samples/Pulls/ReviewComments/ShowComment.hs b/samples/Pulls/ReviewComments/ShowComment.hs new file mode 100644 --- /dev/null +++ b/samples/Pulls/ReviewComments/ShowComment.hs @@ -0,0 +1,22 @@ +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.GithubUser -> String +formatAuthor user = + (Github.githubUserLogin user) ++ " (" ++ (Github.githubUserUrl user) ++ ")" + diff --git a/samples/Pulls/ShowCommits.hs b/samples/Pulls/ShowCommits.hs new file mode 100644 --- /dev/null +++ b/samples/Pulls/ShowCommits.hs @@ -0,0 +1,21 @@ +module ShowCommits where + +import qualified Github.PullRequests as Github +import Data.List +import Data.Maybe + +main = do + possiblePullRequestCommits <- Github.pullRequestCommits "thoughtbot" "paperclip" 575 + case possiblePullRequestCommits of + (Left error) -> putStrLn $ "Error: " ++ (show error) + (Right commits) -> putStrLn $ intercalate "\n" $ map formatCommit commits + +formatCommit commit = + (formatAuthor $ Github.gitCommitAuthor gitCommit) ++ "\n" ++ + (maybe "unknown SHA" id $ Github.gitCommitSha gitCommit) ++ "\n" ++ + (Github.gitCommitMessage gitCommit) + where gitCommit = Github.commitGitCommit commit + +formatAuthor :: Github.GitUser -> String +formatAuthor author = + (Github.gitUserName author) ++ " <" ++ (Github.gitUserEmail author) ++ ">" diff --git a/samples/Pulls/ShowPull.hs b/samples/Pulls/ShowPull.hs new file mode 100644 --- /dev/null +++ b/samples/Pulls/ShowPull.hs @@ -0,0 +1,24 @@ +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.githubUserLogin $ Github.detailedPullRequestUser p) ++ + " opened this pull request " ++ + (formatGithubDate $ Github.detailedPullRequestCreatedAt p) ++ "\n" ++ + (Github.detailedPullRequestTitle p) ++ "\n" ++ + (Github.detailedPullRequestBody p) ++ "\n" ++ + (Github.detailedPullRequestState p) ++ "\n" ++ + "+" ++ (show $ Github.detailedPullRequestAdditions p) ++ " additions\n" ++ + "-" ++ (show $ Github.detailedPullRequestDeletions p) ++ " deletions\n" ++ + (show $ Github.detailedPullRequestComments p) ++ " comments\n" ++ + (Github.detailedPullRequestHtmlUrl p) + +formatGithubDate = show . Github.fromGithubDate diff --git a/samples/Repos/Collaborators/IsCollaborator.hs b/samples/Repos/Collaborators/IsCollaborator.hs new file mode 100644 --- /dev/null +++ b/samples/Repos/Collaborators/IsCollaborator.hs @@ -0,0 +1,14 @@ +module IsCollaborator where + +import qualified Github.Repos.Collaborators as Github +import Data.List + +main = do + let userName = "ubuwaits" + possiblyIsCollaborator <- Github.isCollaboratorOn userName "thoughtbot" "paperclip" + case possiblyIsCollaborator of + (Left error) -> putStrLn $ "Error: " ++ (show error) + (Right True) -> + putStrLn $ userName ++ " is a collaborator on thoughtbot's paperclip" + (Right False) -> + putStrLn $ userName ++ " does not collaborate on thoughtbot's paperclip" diff --git a/samples/Repos/Collaborators/ListCollaborators.hs b/samples/Repos/Collaborators/ListCollaborators.hs new file mode 100644 --- /dev/null +++ b/samples/Repos/Collaborators/ListCollaborators.hs @@ -0,0 +1,15 @@ +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.GithubUser -> String +formatAuthor user = + (Github.githubUserLogin user) ++ " (" ++ (Github.githubUserUrl user) ++ ")" diff --git a/samples/Repos/Commits/CommitComment.hs b/samples/Repos/Commits/CommitComment.hs new file mode 100644 --- /dev/null +++ b/samples/Repos/Commits/CommitComment.hs @@ -0,0 +1,21 @@ +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.GithubUser -> String +formatAuthor user = + (Github.githubUserLogin user) ++ " (" ++ (Github.githubUserUrl user) ++ ")" diff --git a/samples/Repos/Commits/CommitComments.hs b/samples/Repos/Commits/CommitComments.hs new file mode 100644 --- /dev/null +++ b/samples/Repos/Commits/CommitComments.hs @@ -0,0 +1,22 @@ +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.GithubUser -> String +formatAuthor user = + (Github.githubUserLogin user) ++ " (" ++ (Github.githubUserUrl user) ++ ")" diff --git a/samples/Repos/Commits/GitDiff.hs b/samples/Repos/Commits/GitDiff.hs new file mode 100644 --- /dev/null +++ b/samples/Repos/Commits/GitDiff.hs @@ -0,0 +1,13 @@ +module GitDiff where + +import qualified Github.Repos.Commits as Github +import Data.List + +main = do + possibleDiff <- Github.diff "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" "HEAD" + either (\error -> putStrLn $ "Error: " ++ (show error)) + (putStrLn . showDiff) + possibleDiff + +showDiff diff = + intercalate "\n\n" $ map Github.filePatch $ Github.diffFiles diff diff --git a/samples/Repos/Commits/GitLog.hs b/samples/Repos/Commits/GitLog.hs new file mode 100644 --- /dev/null +++ b/samples/Repos/Commits/GitLog.hs @@ -0,0 +1,23 @@ +module GitLog where + +import qualified Github.Repos.Commits as Github +import Data.List + +main = do + possibleCommits <- Github.commitsFor "thoughtbot" "paperclip" + case possibleCommits of + (Left error) -> putStrLn $ "Error: " ++ (show error) + (Right commits) -> putStrLn $ intercalate "\n\n" $ map formatCommit commits + +formatCommit :: Github.Commit -> String +formatCommit commit = + "commit " ++ (Github.commitSha commit) ++ + "\nAuthor: " ++ (formatAuthor author) ++ + "\nDate: " ++ (show $ Github.fromGithubDate $ Github.gitUserDate author) ++ + "\n\n\t" ++ (Github.gitCommitMessage gitCommit) + where author = Github.gitCommitAuthor gitCommit + gitCommit = Github.commitGitCommit commit + +formatAuthor :: Github.GitUser -> String +formatAuthor author = + (Github.gitUserName author) ++ " <" ++ (Github.gitUserEmail author) ++ ">" diff --git a/samples/Repos/Commits/GitShow.hs b/samples/Repos/Commits/GitShow.hs new file mode 100644 --- /dev/null +++ b/samples/Repos/Commits/GitShow.hs @@ -0,0 +1,27 @@ +module GitShow where + +import qualified Github.Repos.Commits as Github +import Data.List + +main = do + possibleCommit <- Github.commit "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" + case possibleCommit of + (Left error) -> putStrLn $ "Error: " ++ (show error) + (Right commit) -> putStrLn $ formatCommit commit + +formatCommit :: Github.Commit -> String +formatCommit commit = + "commit " ++ (Github.commitSha commit) ++ + "\nAuthor: " ++ (formatAuthor author) ++ + "\nDate: " ++ (show $ Github.fromGithubDate $ Github.gitUserDate author) ++ + "\n\n\t" ++ (Github.gitCommitMessage gitCommit) ++ "\n" ++ + patches + where author = Github.gitCommitAuthor gitCommit + gitCommit = Github.commitGitCommit commit + patches = + intercalate "\n" $ map Github.filePatch $ Github.commitFiles commit + +formatAuthor :: Github.GitUser -> String +formatAuthor author = + (Github.gitUserName author) ++ " <" ++ (Github.gitUserEmail author) ++ ">" + diff --git a/samples/Repos/Commits/RepoComments.hs b/samples/Repos/Commits/RepoComments.hs new file mode 100644 --- /dev/null +++ b/samples/Repos/Commits/RepoComments.hs @@ -0,0 +1,22 @@ +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.GithubUser -> String +formatAuthor user = + (Github.githubUserLogin user) ++ " (" ++ (Github.githubUserUrl user) ++ ")" diff --git a/samples/Repos/Forks/ListForks.hs b/samples/Repos/Forks/ListForks.hs new file mode 100644 --- /dev/null +++ b/samples/Repos/Forks/ListForks.hs @@ -0,0 +1,15 @@ +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.githubUserLogin $ Github.repoOwner fork) ++ "\t" ++ + (show $ Github.fromGithubDate $ Github.repoPushedAt fork) ++ "\n" ++ + (Github.repoCloneUrl fork) diff --git a/samples/Repos/ListBranches.hs b/samples/Repos/ListBranches.hs new file mode 100644 --- /dev/null +++ b/samples/Repos/ListBranches.hs @@ -0,0 +1,11 @@ +module ListBranches where + +import qualified Github.Repos as Github +import Data.List + +main = do + possibleBranches <- Github.branchesFor "thoughtbot" "paperclip" + case possibleBranches of + (Left error) -> putStrLn $ "Error: " ++ (show error) + (Right branches) -> + putStrLn $ intercalate "\n" $ map Github.branchName branches diff --git a/samples/Repos/ListContributors.hs b/samples/Repos/ListContributors.hs new file mode 100644 --- /dev/null +++ b/samples/Repos/ListContributors.hs @@ -0,0 +1,16 @@ +module ListContributors where + +import qualified Github.Repos as Github +import Data.List + +main = do + possibleContributors <- Github.contributors "thoughtbot" "paperclip" + case possibleContributors of + (Left error) -> putStrLn $ "Error: " ++ (show error) + (Right contributors) -> + putStrLn $ intercalate "\n" $ map formatContributor contributors + +formatContributor (Github.KnownContributor contributions _ login _ _ _) = + (show $ contributions) ++ "\t" ++ login +formatContributor (Github.AnonymousContributor contributions name) = + (show $ contributions) ++ "\t" ++ name diff --git a/samples/Repos/ListContributorsWithAnonymous.hs b/samples/Repos/ListContributorsWithAnonymous.hs new file mode 100644 --- /dev/null +++ b/samples/Repos/ListContributorsWithAnonymous.hs @@ -0,0 +1,16 @@ +module ListContributorsWithAnonymous where + +import qualified Github.Repos as Github +import Data.List + +main = do + possibleContributors <- Github.contributorsWithAnonymous "thoughtbot" "paperclip" + case possibleContributors of + (Left error) -> putStrLn $ "Error: " ++ (show error) + (Right contributors) -> + putStrLn $ intercalate "\n" $ map formatContributor contributors + +formatContributor (Github.KnownContributor contributions _ login _ _ _) = + (show $ contributions) ++ "\t" ++ login +formatContributor (Github.AnonymousContributor contributions name) = + (show $ contributions) ++ "\t" ++ name diff --git a/samples/Repos/ListLanguages.hs b/samples/Repos/ListLanguages.hs new file mode 100644 --- /dev/null +++ b/samples/Repos/ListLanguages.hs @@ -0,0 +1,14 @@ +module ListLanguages where + +import qualified Github.Repos as Github +import Data.List + +main = do + possibleLanguages <- Github.languagesFor "mike-burns" "ohlaunch" + case possibleLanguages of + (Left error) -> putStrLn $ "Error: " ++ (show error) + (Right languages) -> + putStrLn $ intercalate "\n" $ map formatLanguage languages + +formatLanguage (Github.Language name characterCount) = + name ++ "\t" ++ show characterCount diff --git a/samples/Repos/ListOrgRepos.hs b/samples/Repos/ListOrgRepos.hs new file mode 100644 --- /dev/null +++ b/samples/Repos/ListOrgRepos.hs @@ -0,0 +1,23 @@ +module ListOrgRepos where + +import qualified Github.Repos as Github +import Data.List + +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" ++ + (Github.repoDescription repo) ++ "\n" ++ + (Github.repoHtmlUrl repo) ++ "\n" ++ + (Github.repoCloneUrl repo) ++ "\t" ++ + (formatDate $ Github.repoUpdatedAt repo) ++ "\n" ++ + "language: " ++ (Github.repoLanguage repo) ++ "\t" ++ + "watchers: " ++ (show $ Github.repoWatchers repo) ++ "\t" ++ + "forks: " ++ (show $ Github.repoForks repo) + +formatDate = show . Github.fromGithubDate + diff --git a/samples/Repos/ListTags.hs b/samples/Repos/ListTags.hs new file mode 100644 --- /dev/null +++ b/samples/Repos/ListTags.hs @@ -0,0 +1,11 @@ +module ListTags where + +import qualified Github.Repos as Github +import Data.List + +main = do + possibleTags <- Github.tagsFor "thoughtbot" "paperclip" + case possibleTags of + (Left error) -> putStrLn $ "Error: " ++ (show error) + (Right tags) -> + putStrLn $ intercalate "\n" $ map Github.tagName tags diff --git a/samples/Repos/ListUserRepos.hs b/samples/Repos/ListUserRepos.hs new file mode 100644 --- /dev/null +++ b/samples/Repos/ListUserRepos.hs @@ -0,0 +1,22 @@ +module ListUserRepos where + +import qualified Github.Repos as Github +import Data.List + +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" ++ + (Github.repoDescription repo) ++ "\n" ++ + (Github.repoHtmlUrl repo) ++ "\n" ++ + (Github.repoCloneUrl repo) ++ "\t" ++ + (formatDate $ Github.repoUpdatedAt repo) ++ "\n" ++ + "language: " ++ (Github.repoLanguage repo) ++ "\t" ++ + "watchers: " ++ (show $ Github.repoWatchers repo) ++ "\t" ++ + "forks: " ++ (show $ Github.repoForks repo) + +formatDate = show . Github.fromGithubDate diff --git a/samples/Repos/ShowRepo.hs b/samples/Repos/ShowRepo.hs new file mode 100644 --- /dev/null +++ b/samples/Repos/ShowRepo.hs @@ -0,0 +1,22 @@ +module ShowRepo where + +import qualified Github.Repos as Github +import Data.List + +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" ++ + (Github.repoDescription repo) ++ "\n" ++ + (Github.repoHtmlUrl repo) ++ "\n" ++ + (Github.repoCloneUrl repo) ++ "\t" ++ + (formatDate $ Github.repoUpdatedAt repo) ++ "\n" ++ + "language: " ++ (Github.repoLanguage repo) ++ "\t" ++ + "watchers: " ++ (show $ Github.repoWatchers repo) ++ "\t" ++ + "forks: " ++ (show $ Github.repoForks repo) + +formatDate = show . Github.fromGithubDate diff --git a/samples/Repos/Watching/ListWatched.hs b/samples/Repos/Watching/ListWatched.hs new file mode 100644 --- /dev/null +++ b/samples/Repos/Watching/ListWatched.hs @@ -0,0 +1,22 @@ +module ListWatched where + +import qualified Github.Repos.Watching as Github +import Data.List (intercalate) + +main = do + possibleRepos <- Github.reposWatchedBy "mike-burns" + putStrLn $ either (("Error: "++) . show) + (intercalate "\n\n" . map formatRepo) + possibleRepos + +formatRepo repo = + (Github.repoName repo) ++ "\t" ++ + (Github.repoDescription repo) ++ "\n" ++ + (Github.repoHtmlUrl repo) ++ "\n" ++ + (Github.repoCloneUrl repo) ++ "\t" ++ + (formatDate $ Github.repoUpdatedAt repo) ++ "\n" ++ + "language: " ++ (Github.repoLanguage repo) ++ "\t" ++ + "watchers: " ++ (show $ Github.repoWatchers repo) ++ "\t" ++ + "forks: " ++ (show $ Github.repoForks repo) + +formatDate = show . Github.fromGithubDate diff --git a/samples/Repos/Watching/ListWatchers.hs b/samples/Repos/Watching/ListWatchers.hs new file mode 100644 --- /dev/null +++ b/samples/Repos/Watching/ListWatchers.hs @@ -0,0 +1,14 @@ +module ListWatchers where + +import qualified Github.Repos.Watching as Github +import Data.List (intercalate) + +main = do + possibleWatchers <- Github.watchersFor "thoughtbot" "paperclip" + putStrLn $ either (("Error: "++) . show) + (intercalate "\n" . map formatWatcher) + possibleWatchers + +formatWatcher :: Github.GithubUser -> String +formatWatcher user = + (Github.githubUserLogin user) ++ " (" ++ (Github.githubUserUrl user) ++ ")" diff --git a/samples/Users/Followers/ListFollowers.hs b/samples/Users/Followers/ListFollowers.hs new file mode 100644 --- /dev/null +++ b/samples/Users/Followers/ListFollowers.hs @@ -0,0 +1,12 @@ +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.githubUserLogin diff --git a/samples/Users/Followers/ListFollowing.hs b/samples/Users/Followers/ListFollowing.hs new file mode 100644 --- /dev/null +++ b/samples/Users/Followers/ListFollowing.hs @@ -0,0 +1,13 @@ +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.githubUserLogin + diff --git a/samples/Users/ShowUser.hs b/samples/Users/ShowUser.hs new file mode 100644 --- /dev/null +++ b/samples/Users/ShowUser.hs @@ -0,0 +1,35 @@ +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 = + (formatName userName login) ++ "\t" ++ (fromMaybe "" company) ++ "\t" ++ + (fromMaybe "" location) ++ "\n" ++ + (fromMaybe "" blog) ++ "\t" ++ "<" ++ email ++ ">" ++ "\n" ++ + htmlUrl ++ "\t" ++ (formatDate createdAt) ++ "\n" ++ + "hireable: " ++ (formatHireable isHireable) ++ "\n\n" ++ + (fromMaybe "" bio) + where + userName = Github.detailedUserName user + login = Github.detailedUserLogin user + company = Github.detailedUserCompany user + location = Github.detailedUserLocation user + blog = Github.detailedUserBlog user + email = Github.detailedUserEmail user + htmlUrl = Github.detailedUserHtmlUrl user + createdAt = Github.detailedUserCreatedAt user + isHireable = Github.detailedUserHireable user + bio = Github.detailedUserBio user + +formatName Nothing login = login +formatName (Just name) login = name ++ "(" ++ login ++ ")" + +formatHireable True = "yes" +formatHireable False = "no" + +formatDate = show . Github.fromGithubDate