Skip to content

Commit 299507c

Browse files
phadejphadej
committed
Add github and github' convinience functions
1 parent a04cba6 commit 299507c

File tree

4 files changed

+83
-12
lines changed

4 files changed

+83
-12
lines changed

‎README.md‎

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -63,11 +63,12 @@ import Data.Text (Text, pack)
6363
import Data.Text.IO as T (putStrLn)
6464
import Data.Monoid ((<>))
6565

66-
import qualified GitHub.Endpoints.Users.Followers as GitHub
66+
import GitHub (github')
67+
import qualified GitHub
6768

6869
main :: IO ()
6970
main = do
70-
possibleUsers <- GitHub.usersFollowing "mike-burns"
71+
possibleUsers <- github GitHub.usersFollowingR "phadej"
7172
T.putStrLn $ either (("Error: " <>) . pack . show)
7273
(foldMap ((<> "\n") . formatUser))
7374
possibleUsers
@@ -98,7 +99,7 @@ Copyright
9899

99100
Copyright 2011-2012 Mike Burns.
100101
Copyright 2013-2015 John Wiegley.
101-
Copyright 2016 Oleg Grenrus.
102+
Copyright 2016-2019 Oleg Grenrus.
102103

103104
Available under the BSD 3-clause license.
104105

‎github.cabal‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@ description:
1515
>
1616
> main :: IO ()
1717
> main = do
18-
> possibleUser <- GH.executeRequest' $ GH.userInfoForR "phadej"
18+
> possibleUser <- GH.github' GH.userInfoForR "phadej"
1919
> print possibleUser
2020
.
2121
For more of an overview please see the README: <https://github.com/phadej/github/blob/master/README.md>

‎src/GitHub.hs‎

Lines changed: 8 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -6,11 +6,17 @@
66
-- This module re-exports all request constructrors and data definitions from
77
-- this package.
88
--
9-
-- See "GitHub.Request" module for executing 'Request', or other modules
10-
-- of this package (e.g. "GitHub.Endpoints.Users") for already composed versions.
9+
-- See "GitHub.Request" module for executing 'Request', in short
10+
-- use @'github' request@, for example
11+
--
12+
-- @
13+
-- 'github' 'userInfoForR'
14+
-- :: 'AuthMethod' am => am -> 'Name' 'User' -> IO (Either 'Error' 'User')
15+
-- @
1116
--
1217
-- The missing endpoints lists show which endpoints we know are missing, there
1318
-- might be more.
19+
--
1420
module GitHub (
1521
-- * Activity
1622
-- | See <https://developer.github.com/v3/activity/>

‎src/GitHub/Request.hs‎

Lines changed: 70 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,11 @@
1-
{-# LANGUAGE CPP #-}
2-
{-# LANGUAGE FlexibleContexts #-}
3-
{-# LANGUAGE FlexibleInstances #-}
4-
{-# LANGUAGE GADTs #-}
5-
{-# LANGUAGE KindSignatures #-}
6-
{-# LANGUAGE MultiParamTypeClasses #-}
1+
{-# LANGUAGE CPP #-}
2+
{-# LANGUAGE FlexibleContexts #-}
3+
{-# LANGUAGE FlexibleInstances #-}
4+
{-# LANGUAGE FunctionalDependencies #-}
5+
{-# LANGUAGE GADTs #-}
6+
{-# LANGUAGE KindSignatures #-}
7+
{-# LANGUAGE ScopedTypeVariables #-}
8+
{-# LANGUAGE UndecidableInstances #-}
79
-----------------------------------------------------------------------------
810
-- |
911
-- License : BSD-3-Clause
@@ -29,6 +31,11 @@
2931
-- > githubRequest :: GH.Request 'False a -> GithubMonad a
3032
-- > githubRequest = singleton
3133
module GitHub.Request (
34+
-- * A convinient execution of requests
35+
github,
36+
github',
37+
GitHubRW,
38+
GitHubRO,
3239
-- * Types
3340
Request,
3441
GenRequest (..),
@@ -107,6 +114,63 @@ import GitHub.Data.Request
107114

108115
import Paths_github (version)
109116

117+
-------------------------------------------------------------------------------
118+
-- Convinience
119+
-------------------------------------------------------------------------------
120+
121+
-- | A convinience function to turn functions returning @'Request' rw x@,
122+
-- into functions returning @IO (Either 'Error' x)@.
123+
--
124+
-- >>> :t \auth -> github auth userInfoForR
125+
-- \auth -> github auth userInfoForR
126+
-- :: AuthMethod am => am -> Name User -> IO (Either Error User)
127+
--
128+
-- >>> :t github pullRequestsForR
129+
-- \auth -> github auth pullRequestsForR
130+
-- :: AuthMethod am =>
131+
-- am
132+
-- -> Name Owner
133+
-- -> Name Repo
134+
-- -> PullRequestMod
135+
-- -> FetchCount
136+
-- -> IO (Either Error (Data.Vector.Vector SimplePullRequest))
137+
--
138+
github :: (AuthMethod am, GitHubRW req res) => am -> req -> res
139+
github = githubImpl
140+
141+
-- | Like 'github'' but for 'RO' i.e. read-only requests.
142+
-- Note that GitHub has low request limit for non-authenticated requests.
143+
--
144+
-- >>> :t github' userInfoForR
145+
-- github' userInfoForR :: Name User -> IO (Either Error User)
146+
--
147+
github' :: GitHubRO req res => req -> res
148+
github' = githubImpl'
149+
150+
-- | A type-class implementing 'github'.
151+
class GitHubRW req res | req -> res where
152+
githubImpl :: AuthMethod am => am -> req -> res
153+
154+
-- | A type-class implementing 'github''.
155+
class GitHubRO req res | req -> res where
156+
githubImpl' :: req -> res
157+
158+
instance (ParseResponse mt req, res ~ Either Error req) => GitHubRW (GenRequest mt rw req) (IO res) where
159+
githubImpl = executeRequest
160+
161+
instance (ParseResponse mt req, res ~ Either Error req, rw ~ 'RO) => GitHubRO (GenRequest mt rw req) (IO res) where
162+
githubImpl' = executeRequest'
163+
164+
instance GitHubRW req res => GitHubRW (a -> req) (a -> res) where
165+
githubImpl am req x = githubImpl am (req x)
166+
167+
instance GitHubRO req res => GitHubRO (a -> req) (a -> res) where
168+
githubImpl' req x = githubImpl' (req x)
169+
170+
-------------------------------------------------------------------------------
171+
-- Execution
172+
-------------------------------------------------------------------------------
173+
110174
#ifdef MIN_VERSION_http_client_tls
111175
withOpenSSL :: IO a -> IO a
112176
withOpenSSL = id

0 commit comments

Comments
 (0)