packages feed

github 0.7.1 → 0.7.2

raw patch · 26 files changed

+335/−120 lines, 26 filesdep +hashabledep ~aesondep ~time

Dependencies added: hashable

Dependency ranges changed: aeson, time

Files

Github/Data.hs view
@@ -11,10 +11,11 @@ import Control.Monad import qualified Data.Text as T import Data.Aeson.Types+import Data.Monoid import System.Locale (defaultTimeLocale)-import Data.Attoparsec.Number (Number(..)) import qualified Data.Vector as V import qualified Data.HashMap.Lazy as Map+import Data.Hashable (Hashable)  import Github.Data.Definitions @@ -394,10 +395,16 @@   parseJSON _ = fail "Could not build a PullRequestLinks"  instance FromJSON PullRequestCommit where-  parseJSON (Object o) =+  parseJSON (Object _) =     return PullRequestCommit   parseJSON _ = fail "Could not build a PullRequestCommit" +instance FromJSON SearchReposResult where+  parseJSON (Object o) =+    SearchReposResult <$> o .: "total_count"+                      <*> o .:< "items"+  parseJSON _ = fail "Could not build a SearchReposResult"+ instance FromJSON Repo where   parseJSON (Object o) =     Repo <$> o .: "ssh_url"@@ -425,8 +432,16 @@          <*> o .:? "has_wiki"          <*> o .:? "has_issues"          <*> o .:? "has_downloads"+	 <*> o .:? "parent"+	 <*> o .:? "source"   parseJSON _ = fail "Could not build a Repo" +instance FromJSON RepoRef where+  parseJSON (Object o) =+    RepoRef <$> o .: "owner"+            <*> o .: "name"+  parseJSON _ = fail "Could not build a RepoRef"+ instance FromJSON Contributor where   parseJSON (Object o)     | o `at` "type" == (Just "Anonymous") =@@ -514,11 +529,14 @@                    Just v  -> parseJSON v  -- | Produce all values for the given key.+values :: (Eq k, Hashable k, FromJSON v) => Map.HashMap k Value -> k -> Parser v obj `values` key =   let (Object children) = findWithDefault (Object Map.empty) key obj in     parseJSON $ Array $ V.fromList $ Map.elems children  -- | Produce the value for the last key by traversing.+(<.:>) :: (FromJSON v, Monoid v) => Object => [T.Text] -> Parser v+_obj <.:> [] = pure mempty obj <.:> [key] = obj .: key obj <.:> (key:keys) =   let (Object nextObj) = findWithDefault (Object Map.empty) key obj in@@ -529,6 +547,7 @@ obj `at` key = Map.lookup key obj  -- Taken from Data.Map:+findWithDefault :: (Eq k, Hashable k) => v -> k -> Map.HashMap k v -> v findWithDefault def k m =   case Map.lookup k m of     Nothing -> def
Github/Data/Definitions.hs view
@@ -60,7 +60,7 @@   ,githubOwnerLogin :: String   ,githubOwnerUrl :: String   ,githubOwnerId :: Int-  ,githubOwnerGravatarId :: String+  ,githubOwnerGravatarId :: Maybe String   }   | GithubOrganization {    githubOwnerAvatarUrl :: String@@ -364,6 +364,11 @@ data PullRequestCommit = PullRequestCommit { } deriving (Show, Data, Typeable, Eq, Ord) +data SearchReposResult = SearchReposResult {+  searchReposTotalCount :: Int+  ,searchReposRepos :: [ Repo ]+} deriving (Show, Data, Typeable, Eq, Ord)+ data Repo = Repo {    repoSshUrl :: String   ,repoDescription :: Maybe String@@ -390,8 +395,13 @@   ,repoHasWiki :: Maybe Bool   ,repoHasIssues :: Maybe Bool   ,repoHasDownloads :: Maybe Bool+  ,repoParent :: Maybe RepoRef+  ,repoSource :: Maybe RepoRef } deriving (Show, Data, Typeable, Eq, Ord) +data RepoRef = RepoRef GithubOwner String -- Repo owner and name+ 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.@@ -434,7 +444,7 @@   ,detailedOwnerFollowers :: Int   ,detailedOwnerFollowing :: Int   ,detailedOwnerHireable :: Bool-  ,detailedOwnerGravatarId :: String+  ,detailedOwnerGravatarId :: Maybe String   ,detailedOwnerBlog :: Maybe String   ,detailedOwnerBio :: Maybe String   ,detailedOwnerPublicRepos :: Int
Github/Gists.hs view
@@ -26,7 +26,7 @@ -- -- > gist' (Just ("github-username", "github-password")) "225074" gist' :: Maybe GithubAuth -> String -> IO (Either Error Gist)-gist' auth gistId = githubGet' auth ["gists", gistId]+gist' auth reqGistId = githubGet' auth ["gists", reqGistId]  -- | A specific gist, given its id. --
Github/Gists/Comments.hs view
@@ -13,10 +13,10 @@ -- -- > commentsOn "1174060" commentsOn :: String -> IO (Either Error [GistComment])-commentsOn gistId = githubGet ["gists", gistId, "comments"]+commentsOn reqGistId = githubGet ["gists", reqGistId, "comments"]  -- | A specific comment, by the comment ID. -- -- > comment "62449" comment :: String -> IO (Either Error GistComment)-comment commentId = githubGet ["gists", "comments", commentId]+comment reqCommentId = githubGet ["gists", "comments", reqCommentId]
Github/GitData/Blobs.hs view
@@ -12,5 +12,5 @@ -- -- > blob "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" blob :: String -> String -> String -> IO (Either Error Blob)-blob user repoName sha =-  githubGet ["repos", user, repoName, "git", "blobs", sha]+blob user reqRepoName sha =+  githubGet ["repos", user, reqRepoName, "git", "blobs", sha]
Github/GitData/Commits.hs view
@@ -12,5 +12,5 @@ -- -- > commit "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" commit :: String -> String -> String -> IO (Either Error GitCommit)-commit user repoName sha =-  githubGet ["repos", user, repoName, "git", "commits", sha]+commit user reqRepoName sha =+  githubGet ["repos", user, reqRepoName, "git", "commits", sha]
Github/GitData/References.hs view
@@ -15,19 +15,19 @@ -- -- > 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]+reference user reqRepoName ref =+  githubGet ["repos", user, reqRepoName, "git", "refs", ref]  -- | The history of references for a repo. -- -- > references "mike-burns" "github" references :: String -> String -> IO (Either Error [GitReference])-references user repoName =-  githubGet ["repos", user, repoName, "git", "refs"]+references user reqRepoName =+  githubGet ["repos", user, reqRepoName, "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]+namespacedReferences user reqRepoName namespace =+  githubGet ["repos", user, reqRepoName, "git", "refs", namespace]
Github/GitData/Trees.hs view
@@ -13,13 +13,13 @@ -- -- > tree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" tree :: String -> String -> String -> IO (Either Error Tree)-tree user repoName sha =-  githubGet ["repos", user, repoName, "git", "trees", sha]+tree user reqRepoName sha =+  githubGet ["repos", user, reqRepoName, "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]+nestedTree user reqRepoName sha =+  githubGetWithQueryString ["repos", user, reqRepoName, "git", "trees", sha]                            "recursive=1"
Github/Issues.hs view
@@ -21,8 +21,6 @@  import Github.Data import Github.Private-import Data.Aeson.Types-import qualified Data.Aeson as A import Data.List (intercalate) import Data.Time.Format (formatTime) import System.Locale (defaultTimeLocale)@@ -52,8 +50,8 @@ -- -- > issue' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "462" issue' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error Issue)-issue' auth user repoName issueNumber =-  githubGet' auth ["repos", user, repoName, "issues", show issueNumber]+issue' auth user reqRepoName reqIssueNumber =+  githubGet' auth ["repos", user, reqRepoName, "issues", show reqIssueNumber]  -- | Details on a specific issue, given the repo owner and name, and the issue -- number.@@ -67,10 +65,10 @@ -- -- > issuesForRepo' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending] issuesForRepo' :: Maybe GithubAuth -> String -> String -> [IssueLimitation] -> IO (Either Error [Issue])-issuesForRepo' auth user repoName issueLimitations =+issuesForRepo' auth user reqRepoName issueLimitations =   githubGetWithQueryString'      auth-    ["repos", user, repoName, "issues"]+    ["repos", user, reqRepoName, "issues"]     (queryStringFromLimitations issueLimitations)   where     queryStringFromLimitations = intercalate "&" . map convert
Github/Issues/Comments.hs view
@@ -22,22 +22,22 @@ -- -- > comment "thoughtbot" "paperclip" 1468184 comment :: String -> String -> Int -> IO (Either Error IssueComment)-comment user repoName commentId =-  githubGet ["repos", user, repoName, "issues", "comments", show commentId]+comment user reqRepoName reqCommentId =+  githubGet ["repos", user, reqRepoName, "issues", "comments", show reqCommentId]  -- | All comments on an issue, by the issue's number. -- -- > comments "thoughtbot" "paperclip" 635 comments :: String -> String -> Int -> IO (Either Error [IssueComment])-comments user repoName issueNumber =-  githubGet ["repos", user, repoName, "issues", show issueNumber, "comments"]+comments user reqRepoName reqIssueNumber =+  githubGet ["repos", user, reqRepoName, "issues", show reqIssueNumber, "comments"]  -- | All comments on an issue, by the issue's number, using authentication. -- -- > comments' (GithubUser (user, password)) "thoughtbot" "paperclip" 635 comments' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error [IssueComment])-comments' auth user repoName issueNumber =-  githubGet' auth ["repos", user, repoName, "issues", show issueNumber, "comments"]+comments' auth user reqRepoName reqIssueNumber =+  githubGet' auth ["repos", user, reqRepoName, "issues", show reqIssueNumber, "comments"]
Github/Issues/Events.hs view
@@ -14,19 +14,19 @@ -- -- > eventsForIssue "thoughtbot" "paperclip" 49 eventsForIssue :: String -> String -> Int -> IO (Either Error [Event])-eventsForIssue user repoName issueNumber =-  githubGet ["repos", user, repoName, "issues", show issueNumber, "events"]+eventsForIssue user reqRepoName reqIssueNumber =+  githubGet ["repos", user, reqRepoName, "issues", show reqIssueNumber, "events"]  -- | All the events for all issues in a repo. -- -- > eventsForRepo "thoughtbot" "paperclip" eventsForRepo :: String -> String -> IO (Either Error [Event])-eventsForRepo user repoName =-  githubGet ["repos", user, repoName, "issues", "events"]+eventsForRepo user reqRepoName =+  githubGet ["repos", user, reqRepoName, "issues", "events"]  -- | Details on a specific event, by the event's ID. -- -- > event "thoughtbot" "paperclip" 5335772 event :: String -> String -> Int -> IO (Either Error Event)-event user repoName eventId =-  githubGet ["repos", user, repoName, "issues", "events", show eventId]+event user reqRepoName reqEventId =+  githubGet ["repos", user, reqRepoName, "issues", "events", show reqEventId]
Github/Issues/Labels.hs view
@@ -15,25 +15,25 @@ -- -- > labelsOnRepo "thoughtbot" "paperclip" labelsOnRepo :: String -> String -> IO (Either Error [IssueLabel])-labelsOnRepo user repoName = githubGet ["repos", user, repoName, "labels"]+labelsOnRepo user reqRepoName = githubGet ["repos", user, reqRepoName, "labels"]  -- | The labels on an issue in a repo. -- -- > labelsOnIssue "thoughtbot" "paperclip" 585 labelsOnIssue :: String -> String -> Int ->  IO (Either Error [IssueLabel])-labelsOnIssue user repoName issueId =-  githubGet ["repos", user, repoName, "issues", show issueId, "labels"]+labelsOnIssue user reqRepoName reqIssueId =+  githubGet ["repos", user, reqRepoName, "issues", show reqIssueId, "labels"]  -- | All the labels on a repo's milestone, given the milestone ID. -- -- > labelsOnMilestone "thoughtbot" "paperclip" 2 labelsOnMilestone :: String -> String -> Int ->  IO (Either Error [IssueLabel])-labelsOnMilestone user repoName milestoneId =-  githubGet ["repos", user, repoName, "milestones", show milestoneId, "labels"]+labelsOnMilestone user reqRepoName milestoneId =+  githubGet ["repos", user, reqRepoName, "milestones", show milestoneId, "labels"]  -- | A label, by name. -- -- > Github.label "thoughtbot" "paperclip" "bug" label :: String -> String -> String -> IO (Either Error IssueLabel)-label user repoName labelName =-  githubGet ["repos", user, repoName, "labels", labelName]+label user reqRepoName reqLabelName =+  githubGet ["repos", user, reqRepoName, "labels", reqLabelName]
Github/Issues/Milestones.hs view
@@ -20,11 +20,11 @@ -- -- > milestones' (GithubUser (user, password)) "thoughtbot" "paperclip" milestones' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Milestone])-milestones' auth user repoName = githubGet' auth ["repos", user, repoName, "milestones"]+milestones' auth user reqRepoName = githubGet' auth ["repos", user, reqRepoName, "milestones"]  -- | Details on a specific milestone, given it's milestone number. -- -- > milestone "thoughtbot" "paperclip" 2 milestone :: String -> String -> Int -> IO (Either Error Milestone)-milestone user repoName milestoneNumber =-  githubGet ["repos", user, repoName, "milestones", show milestoneNumber]+milestone user reqRepoName reqMilestoneNumber =+  githubGet ["repos", user, reqRepoName, "milestones", show reqMilestoneNumber]
Github/Organizations.hs view
@@ -26,7 +26,7 @@ -- -- > publicOrganization' (Just ("github-username", "github-password")) "thoughtbot" publicOrganization' :: Maybe GithubAuth -> String -> IO (Either Error Organization)-publicOrganization' auth organizationName = githubGet' auth ["orgs", organizationName]+publicOrganization' auth reqOrganizationName = githubGet' auth ["orgs", reqOrganizationName]  -- | Details on a public organization. Takes the organization's login. --
Github/Private.hs view
@@ -3,7 +3,6 @@ module Github.Private where  import Github.Data-import Data.Char (isDigit) import Data.Aeson import Data.Attoparsec.ByteString.Lazy import Data.Data@@ -38,9 +37,9 @@ githubGetWithQueryString = githubGetWithQueryString' Nothing  githubGetWithQueryString' :: (FromJSON b, Show b) => Maybe GithubAuth -> [String] -> String -> IO (Either Error b)-githubGetWithQueryString' auth paths queryString =+githubGetWithQueryString' auth paths qs =   githubAPI (BS.pack "GET")-            (buildUrl paths ++ "?" ++ queryString)+            (buildUrl paths ++ "?" ++ qs)             auth             (Nothing :: Maybe Value) @@ -63,8 +62,8 @@  githubAPI :: (ToJSON a, Show a, FromJSON b, Show b) => BS.ByteString -> String           -> Maybe GithubAuth -> Maybe a -> IO (Either Error b)-githubAPI method url auth body = do-  result <- doHttps method url auth (encodeBody body)+githubAPI apimethod url auth body = do+  result <- doHttps apimethod url auth (encodeBody body)   case result of       Left e     -> return (Left (HTTPConnectionError e))       Right resp -> either Left (\x -> jsonResultToE (LBS.pack (show x))@@ -84,19 +83,19 @@          -> IO (Either Error b)     forE = flip . maybe . return . Right -    handleJson resp json@(Array ary) =+    handleJson resp gotjson@(Array ary) =         -- Determine whether the output was paginated, and if so, we must         -- recurse to obtain the subsequent pages, and append those result         -- bodies to the current one.  The aggregate will then be parsed.-        forE json (lookup "Link" (responseHeaders resp)) $ \l ->-            forE json (getNextUrl (BS.unpack l)) $ \nu ->+        forE gotjson (lookup "Link" (responseHeaders resp)) $ \l ->+            forE gotjson (getNextUrl (BS.unpack l)) $ \nu ->                 either (return . Left . HTTPConnectionError)                        (\nextResp -> do                              nextJson <- handleBody nextResp                              return $ (\(Array x) -> Array (ary <> x))                                           <$> nextJson)-                       =<< doHttps method nu auth Nothing-    handleJson _ json = return (Right json)+                       =<< doHttps apimethod nu auth Nothing+    handleJson _ gotjson = return (Right gotjson)      getNextUrl l =         if "rel=\"next\"" `isInfixOf` l@@ -108,16 +107,17 @@ doHttps :: Method -> String -> Maybe GithubAuth         -> Maybe (RequestBody (ResourceT IO))         -> IO (Either E.SomeException (Response LBS.ByteString))-doHttps method url auth body = do-  let requestBody = fromMaybe (RequestBodyBS $ BS.pack "") body-      requestHeaders = maybe [] getOAuth auth+doHttps reqMethod url auth body = do+  let reqBody = fromMaybe (RequestBodyBS $ BS.pack "") body+      reqHeaders = maybe [] getOAuth auth       Just uri = parseUrl url-      request = uri { method = method+      request = uri { method = reqMethod                     , secure = True                     , port = 443-                    , requestBody = requestBody-                    , requestHeaders = requestHeaders <>+                    , requestBody = reqBody+                    , requestHeaders = reqHeaders <>                                        [("User-Agent", "github.hs/0.7.0")]+                                       <> [("Accept", "application/vnd.github.preview")]                     , checkStatus = successOrMissing                     }       authRequest = getAuthRequest auth request@@ -133,8 +133,6 @@   where     getAuthRequest (Just (GithubBasicAuth user pass)) = applyBasicAuth user pass     getAuthRequest _ = id-    getBasicAuth (GithubBasicAuth user pass) = applyBasicAuth user pass-    getBasicAuth _ = id     getOAuth (GithubOAuth token) = [(mk (BS.pack "Authorization"),                                      BS.pack ("token " ++ token))]     getOAuth _ = []
Github/PullRequests.hs view
@@ -20,8 +20,8 @@ -- -- > pullRequestsFor' (Just ("github-username", "github-password")) "rails" "rails" pullRequestsFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [PullRequest])-pullRequestsFor' auth userName repoName =-  githubGet' auth ["repos", userName, repoName, "pulls"]+pullRequestsFor' auth userName reqRepoName =+  githubGet' auth ["repos", userName, reqRepoName, "pulls"]  -- | All pull requests for the repo, by owner and repo name. --@@ -35,8 +35,8 @@ -- -- > pullRequest' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 562 pullRequest' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error DetailedPullRequest)-pullRequest' auth userName repoName number =-  githubGet' auth ["repos", userName, repoName, "pulls", show number]+pullRequest' auth userName reqRepoName number =+  githubGet' auth ["repos", userName, reqRepoName, "pulls", show number]  -- | A detailed pull request, which has much more information. This takes the -- repo owner and name along with the number assigned to the pull request.@@ -51,8 +51,8 @@ -- -- > pullRequestCommits' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688 pullRequestCommits' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error [Commit])-pullRequestCommits' auth userName repoName number =-  githubGet' auth ["repos", userName, repoName, "pulls", show number, "commits"]+pullRequestCommits' auth userName reqRepoName number =+  githubGet' auth ["repos", userName, reqRepoName, "pulls", show number, "commits"]  -- | All the commits on a pull request, given the repo owner, repo name, and -- the number of the pull request.@@ -67,8 +67,8 @@ -- -- > pullRequestFiles' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688 pullRequestFiles' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error [File])-pullRequestFiles' auth userName repoName number =-  githubGet' auth ["repos", userName, repoName, "pulls", show number, "files"]+pullRequestFiles' auth userName reqRepoName number =+  githubGet' auth ["repos", userName, reqRepoName, "pulls", show number, "files"] -- | The individual files that a pull request patches. Takes the repo owner and -- name, plus the number assigned to the pull request. --
Github/Repos.hs view
@@ -6,9 +6,13 @@  -- * Querying repositories  userRepos+,userRepos' ,userRepo+,userRepo' ,organizationRepos+,organizationRepos' ,organizationRepo+,organizationRepo' ,contributors ,contributorsWithAnonymous ,languagesFor@@ -42,7 +46,6 @@ import Github.Data import Github.Private import Network.HTTP.Conduit-import qualified Data.ByteString.Char8 as BS import Control.Applicative import qualified Control.Exception as E import Network.HTTP.Types@@ -62,41 +65,69 @@ -- -- > 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 =+userRepos = userRepos' Nothing++-- | The repos for a user, by their login.+-- | With authentication, but note that private repos are currently not supported.+--+-- > userRepos' (Just (GithubUser (user, password))) "mike-burns" All+userRepos' :: Maybe GithubAuth -> String -> RepoPublicity -> IO (Either Error [Repo])+userRepos' auth userName All =+  githubGetWithQueryString' auth ["users", userName, "repos"] "type=all"+userRepos' auth userName Owner =+  githubGetWithQueryString' auth ["users", userName, "repos"] "type=owner"+userRepos' auth userName Member =+  githubGetWithQueryString' auth ["users", userName, "repos"] "type=member"+userRepos' auth userName Public =+  githubGetWithQueryString' auth ["users", userName, "repos"] "type=public"+userRepos' _auth _userName Private =   return $ Left $ UserError "Cannot access private repos using userRepos"  -- | The repos for an organization, by the organization name. -- -- > organizationRepos "thoughtbot" organizationRepos :: String -> IO (Either Error [Repo])-organizationRepos orgName = githubGet ["orgs", orgName, "repos"]+organizationRepos = organizationRepos' Nothing +-- | The repos for an organization, by the organization name.+-- | With authentication+--+-- > organizationRepos (Just (GithubUser (user, password))) "thoughtbot"+organizationRepos' :: Maybe GithubAuth -> String -> IO (Either Error [Repo])+organizationRepos' auth orgName = githubGet' auth ["orgs", orgName, "repos"]+ -- | A specific organization repo, by the organization name. -- -- > organizationRepo "thoughtbot" "github" organizationRepo :: String -> String -> IO (Either Error Repo)-organizationRepo orgName repoName = githubGet ["orgs", orgName, repoName]+organizationRepo = organizationRepo' Nothing +-- | A specific organization repo, by the organization name.+-- | With authentication+--+-- > organizationRepo (Just (GithubUser (user, password))) "thoughtbot" "github"+organizationRepo' :: Maybe GithubAuth -> String -> String -> IO (Either Error Repo)+organizationRepo' auth orgName reqRepoName = githubGet' auth ["orgs", orgName, reqRepoName]+ -- | Details on a specific repo, given the owner and repo name. -- -- > userRepo "mike-burns" "github" userRepo :: String -> String -> IO (Either Error Repo)-userRepo userName repoName = githubGet ["repos", userName, repoName]+userRepo = userRepo' Nothing +-- | Details on a specific repo, given the owner and repo name.+-- | With authentication+--+-- > userRepo' (Just (GithubUser (user, password))) "mike-burns" "github"+userRepo' :: Maybe GithubAuth -> String -> String -> IO (Either Error Repo)+userRepo' auth userName reqRepoName = githubGet' auth ["repos", userName, reqRepoName]+ -- | The contributors to a repo, given the owner and repo name. -- -- > contributors "thoughtbot" "paperclip" contributors :: String -> String -> IO (Either Error [Contributor])-contributors userName repoName =-  githubGet ["repos", userName, repoName, "contributors"]+contributors userName reqRepoName =+  githubGet ["repos", userName, reqRepoName, "contributors"]  -- | The contributors to a repo, including anonymous contributors (such as -- deleted users or git commits with unknown email addresses), given the owner@@ -104,9 +135,9 @@ -- -- > contributorsWithAnonymous "thoughtbot" "paperclip" contributorsWithAnonymous :: String -> String -> IO (Either Error [Contributor])-contributorsWithAnonymous userName repoName =+contributorsWithAnonymous userName reqRepoName =   githubGetWithQueryString-    ["repos", userName, repoName, "contributors"]+    ["repos", userName, reqRepoName, "contributors"]     "anon=true"  -- | The programming languages used in a repo along with the number of@@ -114,23 +145,23 @@ -- -- > languagesFor "mike-burns" "ohlaunch" languagesFor :: String -> String -> IO (Either Error [Language])-languagesFor userName repoName = do-  result <- githubGet ["repos", userName, repoName, "languages"]+languagesFor userName reqRepoName = do+  result <- githubGet ["repos", userName, reqRepoName, "languages"]   return $ either Left (Right . getLanguages) result  -- | The git tags on a repo, given the repo owner and name. -- -- > tagsFor "thoughtbot" "paperclip" tagsFor :: String -> String -> IO (Either Error [Tag])-tagsFor userName repoName =-  githubGet ["repos", userName, repoName, "tags"]+tagsFor userName reqRepoName =+  githubGet ["repos", userName, reqRepoName, "tags"]  -- | The git branches on a repo, given the repo owner and name. -- -- > branchesFor "thoughtbot" "paperclip" branchesFor :: String -> String -> IO (Either Error [Branch])-branchesFor userName repoName =-  githubGet ["repos", userName, repoName, "branches"]+branchesFor userName reqRepoName =+  githubGet ["repos", userName, reqRepoName, "branches"]   data NewRepo = NewRepo {@@ -140,7 +171,6 @@ , newRepoPrivate      :: (Maybe Bool) , newRepoHasIssues    :: (Maybe Bool) , newRepoHasWiki      :: (Maybe Bool)-, newRepoHasDownloads :: (Maybe Bool) , newRepoAutoInit     :: (Maybe Bool) } deriving Show @@ -151,7 +181,6 @@                   , newRepoPrivate      = private                   , newRepoHasIssues    = hasIssues                   , newRepoHasWiki      = hasWiki-                  , newRepoHasDownloads = hasDownloads                   , newRepoAutoInit     = autoInit                   }) = object                   [ "name"                .= name@@ -164,7 +193,7 @@                   ]  newRepo :: String -> NewRepo-newRepo name = NewRepo name Nothing Nothing Nothing Nothing Nothing Nothing Nothing+newRepo name = NewRepo name Nothing Nothing Nothing Nothing Nothing Nothing  -- | -- Create a new repository.
Github/Repos/Collaborators.hs view
@@ -17,8 +17,8 @@ -- -- > collaboratorsOn "thoughtbot" "paperclip" collaboratorsOn :: String -> String -> IO (Either Error [GithubOwner])-collaboratorsOn userName repoName =-  githubGet ["repos", userName, repoName, "collaborators"]+collaboratorsOn userName reqRepoName =+  githubGet ["repos", userName, reqRepoName, "collaborators"]  -- | Whether the user is collaborating on a repo. Takes the user in question, -- the user who owns the repo, and the repo name.@@ -26,9 +26,9 @@ -- > isCollaboratorOn "mike-burns" "thoughtbot" "paperclip" -- > isCollaboratorOn "johnson" "thoughtbot" "paperclip" isCollaboratorOn :: String -> String -> String -> IO (Either Error Bool)-isCollaboratorOn userName repoOwnerName repoName = do+isCollaboratorOn userName repoOwnerName reqRepoName = do    result <- doHttps (pack "GET")-                     (buildUrl ["repos", repoOwnerName, repoName, "collaborators", userName])+                     (buildUrl ["repos", repoOwnerName, reqRepoName, "collaborators", userName])                      Nothing                      Nothing    return $ either (Left . HTTPConnectionError)
Github/Repos/Commits.hs view
@@ -42,12 +42,12 @@ -- -- > commitCommentFor "thoughtbot" "paperclip" "669575" commitCommentFor :: String -> String -> String -> IO (Either Error Comment)-commitCommentFor user repo commentId =-  githubGet ["repos", user, repo, "comments", commentId]+commitCommentFor user repo reqCommentId =+  githubGet ["repos", user, repo, "comments", reqCommentId]  -- | The diff between two treeishes on a repo. -- -- > diff "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" "HEAD" diff :: String -> String -> String -> String -> IO (Either Error Diff)-diff user repo base head =-  githubGet ["repos", user, repo, "compare", base ++ "..." ++ head]+diff user repo base headref =+  githubGet ["repos", user, repo, "compare", base ++ "..." ++ headref]
Github/Repos/Forks.hs view
@@ -2,6 +2,7 @@ -- <http://developer.github.com/v3/repos/forks/>. module Github.Repos.Forks (  forksFor+,forksFor' ,module Github.Data ) where @@ -12,5 +13,12 @@ -- -- > forksFor "thoughtbot" "paperclip" forksFor :: String -> String -> IO (Either Error [Repo])-forksFor userName repoName =-  githubGet ["repos", userName, repoName, "forks"]+forksFor = forksFor' Nothing++-- | All the repos that are forked off the given repo.+-- | With authentication+--+-- > forksFor' (Just (GithubUser (user, password))) "thoughtbot" "paperclip"+forksFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Repo])+forksFor' auth userName reqRepoName =+  githubGet' auth ["repos", userName, reqRepoName, "forks"]
+ Github/Repos/Starring.hs view
@@ -0,0 +1,28 @@+-- | The repo starring API as described on+-- <http://developer.github.com/v3/repos/starring/>.+module Github.Repos.Starring (+ stargazersFor+,reposStarredBy+,myStarred+,module Github.Data+) where++import Github.Data+import Github.Private++-- | The list of users that have starred the specified Github repo.+--+-- > userInfoFor' Nothing "mike-burns"+stargazersFor :: Maybe GithubAuth -> String -> String -> IO (Either Error [GithubOwner])+stargazersFor auth userName reqRepoName =+  githubGet' auth ["repos", userName, reqRepoName, "stargazers"]++-- | All the public repos starred by the specified user.+--+-- > reposStarredBy Nothing "croaky"+reposStarredBy :: Maybe GithubAuth -> String -> IO (Either Error [Repo])+reposStarredBy auth userName = githubGet' auth ["users", userName, "starred"]++-- | All the repos starred by the authenticated user.+myStarred :: GithubAuth -> IO (Either Error [Repo])+myStarred auth = githubGet' (Just auth) ["user", "starred"]
Github/Repos/Watching.hs view
@@ -2,7 +2,9 @@ -- <http://developer.github.com/v3/repos/watching/>. module Github.Repos.Watching (  watchersFor+,watchersFor' ,reposWatchedBy+,reposWatchedBy' ,module Github.Data ) where @@ -13,11 +15,25 @@ -- -- > watchersFor "thoughtbot" "paperclip" watchersFor :: String -> String -> IO (Either Error [GithubOwner])-watchersFor userName repoName =-  githubGet ["repos", userName, repoName, "watchers"]+watchersFor = watchersFor' Nothing +-- | The list of users that are watching the specified Github repo.+-- | With authentication+--+-- > watchersFor' (Just (GithubUser (user, password))) "thoughtbot" "paperclip"+watchersFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [GithubOwner])+watchersFor' auth userName reqRepoName =+  githubGet' auth ["repos", userName, reqRepoName, "watchers"]+ -- | All the public repos watched by the specified user. -- -- > reposWatchedBy "croaky" reposWatchedBy :: String -> IO (Either Error [Repo])-reposWatchedBy userName = githubGet ["users", userName, "watched"]+reposWatchedBy = reposWatchedBy' Nothing++-- | All the public repos watched by the specified user.+-- | With authentication+--+-- > reposWatchedBy' (Just (GithubUser (user, password))) "croaky"+reposWatchedBy' :: Maybe GithubAuth -> String -> IO (Either Error [Repo])+reposWatchedBy' auth userName = githubGet' auth ["users", userName, "watched"]
+ Github/Search.hs view
@@ -0,0 +1,26 @@+-- | The Github Search API, as described at+-- <http://developer.github.com/v3/search/>.+module Github.Search(+ searchRepos'+,searchRepos+,module Github.Data+,GithubAuth(..)+) where++import Github.Data+import Github.Private++-- | Perform a repository search.+-- | With authentication.+--+-- > searchRepos' (Just $ GithubBasicAuth "github-username" "github-password') "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100"+searchRepos' :: Maybe GithubAuth -> String -> IO (Either Error SearchReposResult)+searchRepos' auth queryString = githubGetWithQueryString' auth ["search/repositories"] queryString++-- | Perform a repository search.+-- | Without authentication.+--+-- > searchRepos "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100"+searchRepos :: String -> IO (Either Error SearchReposResult)+searchRepos = searchRepos' Nothing +
github.cabal view
@@ -7,7 +7,7 @@ -- 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.7.1+Version:             0.7.2  -- A short (one-line) description of the package. Synopsis:            Access to the Github API, v3.@@ -77,6 +77,7 @@                     ,samples/Pulls/ReviewComments/ShowComment.hs                     ,samples/Pulls/ShowCommits.hs                     ,samples/Pulls/ShowPull.hs+                    ,samples/Search/SearchRepos.hs                     ,samples/Repos/Collaborators/IsCollaborator.hs                     ,samples/Repos/Collaborators/ListCollaborators.hs                     ,samples/Repos/Commits/CommitComment.hs@@ -96,6 +97,7 @@                     ,samples/Repos/ShowRepo.hs                     ,samples/Repos/Watching/ListWatched.hs                     ,samples/Repos/Watching/ListWatchers.hs+                    ,samples/Repos/Starring/ListStarred.hs                     ,samples/Users/Followers/ListFollowers.hs                     ,samples/Users/Followers/ListFollowing.hs                     ,samples/Users/ShowUser.hs@@ -109,12 +111,10 @@   type: git   location: git://github.com/fpco/github.git - Library   -- Modules exported by the library.   Exposed-modules: Github.Data,                    Github.Data.Definitions,-                    Github.Gists,                    Github.Gists.Comments,                    Github.GitData.Commits,@@ -134,18 +134,20 @@                    Github.Repos.Commits,                    Github.Repos.Forks,                    Github.Repos.Watching,+                   Github.Repos.Starring,                    Github.Users,                    Github.Users.Followers-+                   Github.Search    -- Packages needed in order to build this package.   Build-depends: base >= 4.0 && < 5.0,                  time,-                 aeson == 0.6.1.0,+                 aeson >= 0.6.1.0,                  attoparsec >= 0.10.3.0,                  bytestring,                  case-insensitive >= 0.4.0.4,                  containers,+                 hashable,                  text,                  old-locale,                  HTTP,@@ -164,3 +166,4 @@   -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.   -- Build-tools:            +  GHC-Options: -Wall -fno-warn-orphans
+ samples/Repos/Starring/ListStarred.hs view
@@ -0,0 +1,24 @@+module ListStarred where++import qualified Github.Repos.Starring as Github+import Data.List (intercalate)+import Data.Maybe (fromMaybe)++main = do+  possibleRepos <- Github.reposStarredBy Nothing "mike-burns"+  putStrLn $ either (("Error: "++) . show)+                    (intercalate "\n\n" . map formatRepo)+                    possibleRepos++formatRepo repo =+  (Github.repoName repo) ++ "\t" +++    (fromMaybe "" $ Github.repoDescription repo) ++ "\n" +++    (Github.repoHtmlUrl repo) ++ "\n" +++    (Github.repoCloneUrl repo) ++ "\t" +++    (formatDate $ Github.repoUpdatedAt repo) ++ "\n" +++    formatLanguage (Github.repoLanguage repo)++formatDate = show . Github.fromGithubDate++formatLanguage (Just language) = "language: " ++ language ++ "\t"+formatLanguage Nothing = ""
+ samples/Search/SearchRepos.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE OverloadedStrings #-}+module SearchRepos where++import qualified Github.Search as Github+import qualified Github.Data as Github+import Control.Monad (forM,forM_)+import Data.Maybe (fromMaybe)+import Data.List (intercalate)+import System.Environment (getArgs)+import Text.Printf (printf)+import Data.Time.Clock (getCurrentTime, UTCTime(..))+import Data.Time.LocalTime (utc,utcToLocalTime,localDay,localTimeOfDay,TimeOfDay(..))+import Data.Time.Calendar (toGregorian)++main = do+  args <- getArgs+  date <- case args of+            (x:_)     -> return x+            otherwise -> today+  let query = "q=language%3Ahaskell created%3A>" ++ date ++ "&per_page=100"+  let auth = Nothing+  result <- Github.searchRepos' auth query+  case result of+    Left e  -> putStrLn $ "Error: " ++ show e+    Right r -> do forM_ (Github.searchReposRepos r) (\r -> do+                    putStrLn $ formatRepo r+                    putStrLn ""+                    )+                  putStrLn $ "Count: " ++ show n ++ " Haskell repos created since " ++ date+      where n = Github.searchReposTotalCount r++-- | return today (in UTC) formatted as YYYY-MM-DD+today :: IO String+today = do+  now <- getCurrentTime+  let day = localDay $ utcToLocalTime utc now+      (y,m,d) = toGregorian day+   in return $ printf "%d-%02d-%02d" y m d++formatRepo :: Github.Repo -> String+formatRepo r =+  let fields = [ ("Name", Github.repoName)+                 ,("URL",  Github.repoHtmlUrl)+                 ,("Description", orEmpty . Github.repoDescription)+                 ,("Created-At", formatDate . Github.repoCreatedAt)+                 ,("Pushed-At", formatMaybeDate . Github.repoPushedAt)+               ]+  in intercalate "\n" $ map fmt fields+    where fmt (s,f) = fill 12 (s ++ ":") ++ " " ++ f r+          orEmpty = fromMaybe ""+          fill n s = s ++ replicate n' ' '+            where n' = max 0 (n - length s) ++formatMaybeDate = maybe "???" formatDate++formatDate = show . Github.fromGithubDate