Merge pull request haskell-github#415 from phadej/github-convinience-function

Add github and github' convinience functions

Author: phadej

CHANGELOG.md

@@ -1,3 +1,20 @@
+## Changes for 0.24
+
+**Major change**:
+Introduce `github` n-ary combinator to hoist `... -> Request rw res`
+into `... -> IO (Either Error res)` (i.e. n-ary `executeRequest`).
+With that in place drop `.. -> IO (Either Error res)` functions.
+
+This reduces symbol bloat in the library.
+[#415](https://github.com/phadej/github/pull/415)
+
+- Remove double `withOpenSSL`
+  [#414](https://github.com/phadej/github/pull/414)
+- Pull requests reviews API uses issue number
+  [#409](https://github.com/phadej/github/pull/409)
+- Update `Repo`, `NewRepo` and `EditRepo` data types
+  [#407](https://github.com/phadej/github/pull/407)
+
 ## Changes for 0.23
 
 - Escape URI paths
@@ -93,7 +110,7 @@
 
 ## Changes for 0.18
 
-- Endpoints for deleting issue comments. 
+- Endpoints for deleting issue comments.
   [#294](https://github.com/phadej/github/pull/294)
 - Endpoints for (un)starring gists.
   [#296](https://github.com/phadej/github/pull/296)

README.md

@@ -63,11 +63,12 @@ import Data.Text         (Text, pack)
 import Data.Text.IO as T (putStrLn)
 import Data.Monoid       ((<>))
 
-import qualified GitHub.Endpoints.Users.Followers as GitHub
+import GitHub (github')
+import qualified GitHub
 
 main :: IO ()
 main = do
-    possibleUsers <- GitHub.usersFollowing "mike-burns"
+    possibleUsers <- github GitHub.usersFollowingR "phadej"
     T.putStrLn $ either (("Error: " <>) . pack . show)
                         (foldMap ((<> "\n") . formatUser))
                         possibleUsers
@@ -98,7 +99,7 @@ Copyright
 
 Copyright 2011-2012 Mike Burns.
 Copyright 2013-2015 John Wiegley.
-Copyright 2016 Oleg Grenrus.
+Copyright 2016-2019 Oleg Grenrus.
 
 Available under the BSD 3-clause license.
 

github.cabal

@@ -1,6 +1,6 @@
 cabal-version:      >=1.10
 name:               github
-version:            0.23
+version:            0.24
 synopsis:           Access to the GitHub API, v3.
 category:           Network
 description:
@@ -15,7 +15,7 @@ description:
   >
   > main :: IO ()
   > main = do
-  >     possibleUser <- GH.executeRequest' $ GH.userInfoForR "phadej"
+  >     possibleUser <- GH.github' GH.userInfoForR "phadej"
   >     print possibleUser
   .
   For more of an overview please see the README: <https://github.com/phadej/github/blob/master/README.md>

samples/RateLimit.hs

@@ -5,4 +5,3 @@ import qualified Github.RateLimit as Github
 main = do
   x <- Github.rateLimit
   print x
-  

samples/Repos/DeployKeys/CreateDeployKey.hs

@@ -1,21 +1,19 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Main (main) where
 
-import qualified GitHub.Data.DeployKeys as DK
-import qualified GitHub.Endpoints.Repos.DeployKeys as DK
-import qualified GitHub.Auth as Auth
+import qualified GitHub as GH
 import Data.Text (Text)
 
 main :: IO ()
 main = do
-  let auth = Auth.OAuth "auth_token"
-  eDeployKey <- DK.createRepoDeployKey' auth "your_owner" "your_repo" newDeployKey
+  let auth = GH.OAuth "auth_token"
+  eDeployKey <- GH.github auth GH.createRepoDeployKeyR "your_owner" "your_repo" newDeployKey
   case eDeployKey of
-    (Left err) -> putStrLn $ "Error: " ++ (show err)
-    (Right deployKey) -> putStrLn $ show deployKey
+    Left err        -> putStrLn $ "Error: " ++ show err
+    Right deployKey -> print deployKey
 
-newDeployKey :: DK.NewRepoDeployKey
-newDeployKey = DK.NewRepoDeployKey publicKey "test-key" True
+newDeployKey :: GH.NewRepoDeployKey
+newDeployKey = GH.NewRepoDeployKey publicKey "test-key" True
   where
     publicKey :: Text
     publicKey = "your_public_key"

samples/Repos/DeployKeys/ListDeployKeys.hs

@@ -1,19 +1,17 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Main (main) where
 
-import qualified GitHub.Data.DeployKeys as DK
-import qualified GitHub.Endpoints.Repos.DeployKeys as DK
-import qualified GitHub.Auth as Auth
+import qualified GitHub as GH
 import Data.List (intercalate)
 import Data.Vector (toList)
 
 main :: IO ()
 main = do
-  let auth = Auth.OAuth "auth_token"
-  eDeployKeys <- DK.deployKeysFor' auth "your_owner" "your_repo"
+  let auth = GH.OAuth "auth_token"
+  eDeployKeys <- GH.github auth GH.deployKeysForR "your_owner" "your_repo" GH.FetchAll
   case eDeployKeys of
-    (Left err) -> putStrLn $ "Error: " ++ (show err)
-    (Right deployKeys) -> putStrLn $ intercalate "\n" $ map formatRepoDeployKey (toList deployKeys)
+    Left err         -> putStrLn $ "Error: " ++ show err
+    Right deployKeys -> putStrLn $ intercalate "\n" $ map formatRepoDeployKey (toList deployKeys)
 
 formatRepoDeployKey :: DK.RepoDeployKey -> String
 formatRepoDeployKey = show

samples/Repos/ShowRepo.hs

@@ -7,18 +7,17 @@ import Data.Maybe
 main = do
   possibleRepo <- Github.repository "mike-burns" "trylambda"
   case possibleRepo of
-       (Left error) -> putStrLn $ "Error: " ++ (show error)
-       (Right repo) -> putStrLn $ formatRepo repo
+       Left error -> putStrLn $ "Error: " ++ show error
+       Right repo -> putStrLn $ formatRepo repo
 
-formatRepo repo =
-  (Github.repoName repo) ++ "\t" ++
-    (fromMaybe "" $ Github.repoDescription repo) ++ "\n" ++
-    (Github.repoHtmlUrl repo) ++ "\n" ++
-    (fromMaybe "" $ Github.repoCloneUrl repo) ++ "\t" ++
-    (fromMaybe "" $ formatDate `fmap` Github.repoUpdatedAt repo) ++ "\n" ++
+formatRepo repo = Github.repoName repo ++ "\t" ++
+    fromMaybe "" (Github.repoDescription repo) ++ "\n" ++
+    Github.repoHtmlUrl repo ++ "\n" ++
+    fromMaybe "" (Github.repoCloneUrl repo) ++ "\t" ++
+    maybe "" formatDate (Github.repoUpdatedAt repo) ++ "\n" ++
     formatLanguage (Github.repoLanguage repo) ++
-    "watchers: " ++ (show $ Github.repoWatchers repo) ++ "\t" ++
-    "forks: " ++ (show $ Github.repoForks repo)
+    "watchers: " ++ show (Github.repoWatchers repo) ++ "\t" ++
+    "forks: " ++ show (Github.repoForks repo)
 
 formatDate = show . Github.fromDate
 

samples/Teams/EditTeam.hs

@@ -5,15 +5,15 @@ module Main (main) where
 import Common
 
 import qualified GitHub
-import qualified GitHub.Endpoints.Organizations.Teams as GitHub
 
 main :: IO ()
 main = do
   args <- getArgs
   result <- case args of
               [token, team_id, team_name, desc] ->
-                GitHub.editTeam'
+                GitHub.github
                   (GitHub.OAuth $ fromString token)
+                  GitHub.editTeamR
                   (GitHub.mkTeamId $ read team_id)
                   (GitHub.EditTeam (GitHub.mkTeamName $ fromString team_name) (Just $ fromString desc) GitHub.PermissionPull)
               _                                 ->

samples/Teams/ListRepos.hs

@@ -4,15 +4,14 @@ module Main (main) where
 import Common
 import Prelude ()
 
-import qualified GitHub
-import qualified GitHub.Endpoints.Organizations.Teams as GitHub
+import qualified GitHub as GH
 
 main :: IO ()
 main = do
     args <- getArgs
     possibleRepos <- case args of
-      [team_id, token] -> GitHub.listTeamRepos' (Just $ GitHub.OAuth $ fromString token) (GitHub.mkTeamId $ read team_id)
-      [team_id]        -> GitHub.listTeamRepos (GitHub.mkTeamId $ read team_id)
+      [team_id, token] -> GH.github (GH.OAuth $ fromString token) GH.listTeamReposR (GH.mkTeamId $ read team_id)
+      [team_id]        -> GH.github' GH.listTeamReposR (GH.mkTeamId $ read team_id)
       _                -> error "usage: TeamListRepos <team_id> [auth token]"
     case possibleRepos of
       Left err    -> putStrLn $ "Error: " <> tshow err

samples/Teams/ListTeamsCurrent.hs

@@ -4,14 +4,13 @@ module Main (main) where
 
 import Common
 
-import qualified GitHub
-import qualified GitHub.Endpoints.Organizations.Teams as GitHub
+import qualified GitHub as GH
 
 main :: IO ()
 main = do
   args <- getArgs
   result <- case args of
-              [token] -> GitHub.listTeamsCurrent' (GitHub.OAuth $ fromString token)
+              [token] -> GH.github (GH.OAuth $ fromString token) GH.listTeamsCurrentR GH.FetchAll
               _       -> error "usage: ListTeamsCurrent <token>"
   case result of
     Left err    -> putStrLn $ "Error: " <> tshow err

samples/Teams/Memberships/AddTeamMembershipFor.hs

@@ -5,20 +5,18 @@ module Main (main) where
 import Common
 
 import qualified GitHub
-import qualified GitHub.Endpoints.Organizations.Teams as GitHub
 
 main :: IO ()
 main = do
   args <- getArgs
   result <- case args of
-              [token, team_id, username] ->
-                GitHub.addTeamMembershipFor'
-                    (GitHub.OAuth $ fromString token)
-                    (GitHub.mkTeamId $ read team_id)
-                    (GitHub.mkOwnerName $ fromString username)
-                    GitHub.RoleMember
-              _                          ->
-                error "usage: AddTeamMembershipFor <token> <team_id> <username>"
+    [token, team_id, username] -> GitHub.github
+      (GitHub.OAuth $ fromString token)
+      GitHub.addTeamMembershipForR
+      (GitHub.mkTeamId $ read team_id)
+      (GitHub.mkOwnerName $ fromString username)
+      GitHub.RoleMember
+    _ -> fail "usage: AddTeamMembershipFor <token> <team_id> <username>"
   case result of
     Left err   -> putStrLn $ "Error: " <> tshow err
     Right team -> putStrLn $ tshow team

samples/Teams/TeamInfoFor.hs

@@ -4,15 +4,14 @@ module Main (main) where
 
 import Common
 
-import qualified GitHub
-import qualified GitHub.Endpoints.Organizations.Teams as GitHub
+import qualified GitHub as GH
 
 main :: IO ()
 main = do
   args <- getArgs
   result <- case args of
-              [team_id, token] -> GitHub.teamInfoFor' (Just $ GitHub.OAuth $ fromString token) (GitHub.mkTeamId $ read team_id)
-              [team_id]        -> GitHub.teamInfoFor (GitHub.mkTeamId $ read team_id)
+              [team_id, token] -> GH.github (GH.OAuth $ fromString token) GH.teamInfoForR (GH.mkTeamId $ read team_id)
+              [team_id]        -> GH.github' GH.teamInfoForR (GH.mkTeamId $ read team_id)
               _                -> error "usage: TeamInfoFor <team_id> [auth token]"
   case result of
     Left err   -> putStrLn $ "Error: " <> tshow err

samples/Users/ShowUser.hs

@@ -6,38 +6,37 @@ import Prelude ()
 
 import Data.Maybe (fromMaybe)
 
-import qualified GitHub
-import qualified GitHub.Endpoints.Users as GitHub
+import qualified GitHub as GH
 
 main :: IO ()
 main = do
-  auth <- getAuth
-  possibleUser <- GitHub.userInfoFor' auth "mike-burns"
+  mauth <- getAuth
+  possibleUser <- maybe GH.github' GH.github mauth GH.userInfoForR "mike-burns"
   putStrLn $ either (("Error: " <>) . tshow) formatUser possibleUser
 
-formatUser :: GitHub.User -> Text
+formatUser :: GH.User -> Text
 formatUser user =
-  (formatName userName login) <> "\t" <> (fromMaybe "" company) <> "\t" <>
-    (fromMaybe "" location) <> "\n" <>
-    (fromMaybe "" blog) <> "\t" <> "<" <> (fromMaybe "" email) <> ">" <> "\n" <>
-    GitHub.getUrl htmlUrl <> "\t" <> tshow createdAt <> "\n" <>
+  formatName userName login <> "\t" <> fromMaybe "" company <> "\t" <>
+    fromMaybe "" location <> "\n" <>
+    fromMaybe "" blog <> "\t" <> "<" <> fromMaybe "" email <> ">" <> "\n" <>
+    GH.getUrl htmlUrl <> "\t" <> tshow createdAt <> "\n" <>
     "hireable: " <> formatHireable (fromMaybe False isHireable) <> "\n\n" <>
-    (fromMaybe "" bio)
+    fromMaybe "" bio
   where
-    userName = GitHub.userName user
-    login = GitHub.userLogin user
-    company = GitHub.userCompany user
-    location = GitHub.userLocation user
-    blog = GitHub.userBlog user
-    email = GitHub.userEmail user
-    htmlUrl = GitHub.userHtmlUrl user
-    createdAt = GitHub.userCreatedAt user
-    isHireable = GitHub.userHireable user
-    bio = GitHub.userBio user
+    userName = GH.userName user
+    login = GH.userLogin user
+    company = GH.userCompany user
+    location = GH.userLocation user
+    blog = GH.userBlog user
+    email = GH.userEmail user
+    htmlUrl = GH.userHtmlUrl user
+    createdAt = GH.userCreatedAt user
+    isHireable = GH.userHireable user
+    bio = GH.userBio user
 
-formatName :: Maybe Text -> GitHub.Name GitHub.User -> Text
-formatName Nothing login = GitHub.untagName login
-formatName (Just name) login = name <> "(" <> GitHub.untagName login <> ")"
+formatName :: Maybe Text -> GH.Name GH.User -> Text
+formatName Nothing login = GH.untagName login
+formatName (Just name) login = name <> "(" <> GH.untagName login <> ")"
 
 formatHireable :: Bool -> Text
 formatHireable True = "yes"