Skip to content

Commit 0858f62

Browse files
phadejphadej
authored
Merge pull request #268 from jamesdabbs/master
Add Statuses endpoints
2 parents b2778cc + d7d8572 commit 0858f62

File tree

6 files changed

+192
-3
lines changed

6 files changed

+192
-3
lines changed

‎github.cabal‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -86,6 +86,7 @@ Library
8686
GitHub.Data.Request
8787
GitHub.Data.Reviews
8888
GitHub.Data.Search
89+
GitHub.Data.Statuses
8990
GitHub.Data.Teams
9091
GitHub.Data.URL
9192
GitHub.Data.Webhooks
@@ -118,6 +119,7 @@ Library
118119
GitHub.Endpoints.Repos.DeployKeys
119120
GitHub.Endpoints.Repos.Forks
120121
GitHub.Endpoints.Repos.Releases
122+
GitHub.Endpoints.Repos.Statuses
121123
GitHub.Endpoints.Repos.Webhooks
122124
GitHub.Endpoints.Search
123125
GitHub.Endpoints.Users

‎spec/GitHub/CommitsSpec.hs‎

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -6,13 +6,12 @@ import qualified GitHub
66

77
import GitHub.Auth (Auth (..))
88
import GitHub.Endpoints.Repos.Commits (Commit, commitSha, commitsFor',
9-
commitsForR, diffR, mkName)
9+
commitsForR, diffR, mkCommitName)
1010
import GitHub.Request (executeRequest)
1111

1212
import Control.Monad (forM_)
1313
import Data.Either.Compat (isRight)
1414
import Data.List (nub, sort)
15-
import Data.Proxy (Proxy (..))
1615
import Data.String (fromString)
1716
import System.Environment (lookupEnv)
1817
import Test.Hspec (Spec, describe, it, pendingWith, shouldBe,
@@ -59,6 +58,5 @@ spec = do
5958
d `shouldSatisfy` isRight
6059

6160
it "issue #155" $ withAuth $ \auth -> do
62-
let mkCommitName = mkName (Proxy :: Proxy Commit)
6361
d <- executeRequest auth $ diffR "nomeata" "codespeed" (mkCommitName "ghc") (mkCommitName "tobami:master")
6462
d `shouldSatisfy` isRight

‎src/GitHub.hs‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -326,6 +326,12 @@ module GitHub (
326326
usersFollowingR,
327327
usersFollowedByR,
328328

329+
-- ** Statuses
330+
-- | See <https://developer.github.com/v3/repos/statuses/>
331+
createStatusR,
332+
statusesForR,
333+
statusForR,
334+
329335
-- * Data definitions
330336
module GitHub.Data,
331337
-- * Request handling
@@ -359,6 +365,7 @@ import GitHub.Endpoints.Repos.Comments
359365
import GitHub.Endpoints.Repos.Commits
360366
import GitHub.Endpoints.Repos.Forks
361367
import GitHub.Endpoints.Repos.Releases
368+
import GitHub.Endpoints.Repos.Statuses
362369
import GitHub.Endpoints.Repos.Webhooks
363370
import GitHub.Endpoints.Search
364371
import GitHub.Endpoints.Users

‎src/GitHub/Data.hs‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,7 @@ module GitHub.Data (
1616
mkTeamName,
1717
mkOrganizationName,
1818
mkRepoName,
19+
mkCommitName,
1920
fromUserName,
2021
fromOrganizationName,
2122
-- ** Id
@@ -48,6 +49,7 @@ module GitHub.Data (
4849
module GitHub.Data.Request,
4950
module GitHub.Data.Reviews,
5051
module GitHub.Data.Search,
52+
module GitHub.Data.Statuses,
5153
module GitHub.Data.Teams,
5254
module GitHub.Data.URL,
5355
module GitHub.Data.Webhooks
@@ -76,6 +78,7 @@ import GitHub.Data.Repos
7678
import GitHub.Data.Request
7779
import GitHub.Data.Reviews
7880
import GitHub.Data.Search
81+
import GitHub.Data.Statuses
7982
import GitHub.Data.Teams
8083
import GitHub.Data.URL
8184
import GitHub.Data.Webhooks
@@ -110,6 +113,9 @@ mkRepoId = Id
110113
mkRepoName :: Text -> Name Repo
111114
mkRepoName = N
112115

116+
mkCommitName :: Text -> Name Commit
117+
mkCommitName = N
118+
113119
fromOrganizationName :: Name Organization -> Name Owner
114120
fromOrganizationName = N . untagName
115121

‎src/GitHub/Data/Statuses.hs‎

Lines changed: 110 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,110 @@
1+
{-# LANGUAGE DeriveDataTypeable #-}
2+
{-# LANGUAGE DeriveGeneric #-}
3+
{-# LANGUAGE NoImplicitPrelude #-}
4+
{-# LANGUAGE OverloadedStrings #-}
5+
module GitHub.Data.Statuses where
6+
7+
import GitHub.Data.Definitions
8+
import GitHub.Data.Name (Name)
9+
import GitHub.Data.Id (Id)
10+
import GitHub.Data.URL (URL)
11+
import GitHub.Internal.Prelude
12+
import Prelude ()
13+
14+
import GitHub.Data.GitData (Commit)
15+
import GitHub.Data.Repos (RepoRef)
16+
17+
18+
data StatusState
19+
= StatusPending
20+
| StatusSuccess
21+
| StatusError
22+
| StatusFailure
23+
deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic)
24+
25+
instance NFData StatusState where rnf = genericRnf
26+
instance Binary StatusState
27+
28+
instance FromJSON StatusState where
29+
parseJSON (String "pending") = pure StatusPending
30+
parseJSON (String "success") = pure StatusSuccess
31+
parseJSON (String "error") = pure StatusError
32+
parseJSON (String "failure") = pure StatusFailure
33+
parseJSON _ = fail "Could not build a StatusState"
34+
35+
instance ToJSON StatusState where
36+
toJSON StatusPending = String "pending"
37+
toJSON StatusSuccess = String "success"
38+
toJSON StatusError = String "error"
39+
toJSON StatusFailure = String "failure"
40+
41+
42+
data Status = Status
43+
{ statusCreatedAt :: !UTCTime
44+
, statusUpdatedAt :: !UTCTime
45+
, statusState :: !StatusState
46+
, statusTargetUrl :: !(Maybe URL)
47+
, statusDescription :: !(Maybe Text)
48+
, statusId :: !(Id Status)
49+
, statusUrl :: !URL
50+
, statusContext :: !(Maybe Text)
51+
, statusCreator :: !(Maybe SimpleUser)
52+
}
53+
deriving (Show, Data, Typeable, Eq, Ord, Generic)
54+
55+
instance FromJSON Status where
56+
parseJSON = withObject "Status" $ \o -> Status
57+
<$> o .: "created_at"
58+
<*> o .: "updated_at"
59+
<*> o .: "state"
60+
<*> o .:? "target_url"
61+
<*> o .:? "description"
62+
<*> o .: "id"
63+
<*> o .: "url"
64+
<*> o .:? "context"
65+
<*> o .:? "creator"
66+
67+
68+
data NewStatus = NewStatus
69+
{ newStatusState :: !StatusState
70+
, newStatusTargetUrl :: !(Maybe URL)
71+
, newStatusDescription :: !(Maybe Text)
72+
, newStatusContext :: !(Maybe Text)
73+
}
74+
deriving (Show, Data, Typeable, Eq, Ord, Generic)
75+
76+
instance NFData NewStatus where rnf = genericRnf
77+
instance Binary NewStatus
78+
79+
instance ToJSON NewStatus where
80+
toJSON (NewStatus s t d c) = object $ filter notNull $
81+
[ "state" .= s
82+
, "target_url" .= t
83+
, "description" .= d
84+
, "context" .= c
85+
]
86+
where
87+
notNull (_, Null) = False
88+
notNull (_, _) = True
89+
90+
91+
data CombinedStatus = CombinedStatus
92+
{ combinedStatusState :: !StatusState
93+
, combinedStatusSha :: !(Name Commit)
94+
, combinedStatusTotalCount :: !Int
95+
, combinedStatusStatuses :: !(Vector Status)
96+
, combinedStatusRepository :: !RepoRef
97+
, combinedStatusCommitUrl :: !URL
98+
, combinedStatusUrl :: !URL
99+
}
100+
deriving (Show, Data, Typeable, Eq, Ord, Generic)
101+
102+
instance FromJSON CombinedStatus where
103+
parseJSON = withObject "CombinedStatus" $ \o -> CombinedStatus
104+
<$> o .: "state"
105+
<*> o .: "sha"
106+
<*> o .: "total_count"
107+
<*> o .: "statuses"
108+
<*> o .: "repository"
109+
<*> o .: "commit_url"
110+
<*> o .: "url"

‎src/GitHub/Endpoints/Repos/Statuses.hs‎

Lines changed: 66 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,66 @@
1+
-----------------------------------------------------------------------------
2+
-- |
3+
-- License : BSD-3-Clause
4+
-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>
5+
--
6+
-- The repo statuses API as described on
7+
-- <https://developer.github.com/v3/repos/statuses/>.
8+
module GitHub.Endpoints.Repos.Statuses (
9+
createStatus,
10+
createStatusR,
11+
statusesFor,
12+
statusesForR,
13+
statusFor,
14+
statusForR,
15+
module GitHub.Data
16+
) where
17+
18+
import GitHub.Data
19+
import GitHub.Internal.Prelude
20+
import GitHub.Request
21+
import Prelude ()
22+
23+
-- | Create a new status
24+
--
25+
-- > createStatus (BasicAuth user password) "thoughtbot" "paperclip"
26+
-- > "41f685f6e01396936bb8cd98e7cca517e2c7d96b"
27+
-- > (NewStatus StatusSuccess Nothing "Looks good!" Nothing)
28+
createStatus :: Auth -> Name Owner -> Name Repo -> Name Commit -> NewStatus -> IO (Either Error Status)
29+
createStatus auth owner repo sha ns =
30+
executeRequest auth $ createStatusR owner repo sha ns
31+
32+
-- | Create a new status
33+
-- See <https://developer.github.com/v3/repos/statuses/#create-a-status>
34+
createStatusR :: Name Owner -> Name Repo -> Name Commit -> NewStatus -> Request 'RW Status
35+
createStatusR owner repo sha =
36+
command Post parts . encode
37+
where
38+
parts = ["repos", toPathPart owner, toPathPart repo, "statuses", toPathPart sha]
39+
40+
-- | All statuses for a commit
41+
--
42+
-- > statusesFor (BasicAuth user password) "thoughtbot" "paperclip"
43+
-- > "41f685f6e01396936bb8cd98e7cca517e2c7d96b"
44+
statusesFor :: Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error (Vector Status))
45+
statusesFor auth user repo sha =
46+
executeRequest auth $ statusesForR user repo sha FetchAll
47+
48+
-- | All statuses for a commit
49+
-- See <https://developer.github.com/v3/repos/statuses/#list-statuses-for-a-specific-ref>
50+
statusesForR :: Name Owner -> Name Repo -> Name Commit -> FetchCount -> Request 'RW (Vector Status)
51+
statusesForR user repo sha =
52+
pagedQuery ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "statuses"] []
53+
54+
-- | The combined status for a specific commit
55+
--
56+
-- > statusFor (BasicAuth user password) "thoughtbot" "paperclip"
57+
-- > "41f685f6e01396936bb8cd98e7cca517e2c7d96b"
58+
statusFor :: Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error CombinedStatus)
59+
statusFor auth user repo sha =
60+
executeRequest auth $ statusForR user repo sha
61+
62+
-- | The combined status for a specific commit
63+
-- See <https://developer.github.com/v3/repos/statuses/#get-the-combined-status-for-a-specific-ref>
64+
statusForR :: Name Owner -> Name Repo -> Name Commit -> Request 'RW CombinedStatus
65+
statusForR user repo sha =
66+
query ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "status"] []

0 commit comments

Comments
 (0)