diff --git a/octohat.cabal b/octohat.cabal --- a/octohat.cabal +++ b/octohat.cabal @@ -1,7 +1,7 @@ Name: octohat Synopsis: A tested, minimal wrapper around GitHub's API. Description: A tested, minimal wrapper around GitHub's API. -Version: 0.1.4.1 +Version: 0.1.4.2 License: MIT License-file: LICENSE Author: Stack Builders @@ -18,7 +18,7 @@ Build-depends: aeson == 0.8.* - , base >= 4.4 && < 4.8 + , base >= 4.4 && < 4.9 , base-compat == 0.6.* , base16-bytestring == 0.1.1.* , base64-bytestring == 1.0.* @@ -31,13 +31,13 @@ , ghc-prim >= 0.2 , http-client == 0.4.* , http-types == 0.8.* - , lens >= 4.0 && <= 4.7.0.1 + , lens >= 4.0 && < 4.10 , mtl == 2.* , text == 1.2.* - , time == 1.4.* - , transformers == 0.3.* + , time >= 1.4 && < 1.6 + , transformers >= 0.3 && < 0.5 , unordered-containers == 0.2.* - , wreq == 0.3.* + , wreq-sb == 0.4.* , xmlhtml == 0.2.* ghc-options: -Wall @@ -56,12 +56,12 @@ Build-depends: aeson ==0.8.0.* - , base >=4.4 && <4.8 + , base >=4.4 && <4.9 , text , optparse-applicative ==0.11.0.* , octohat , utf8-string >=0.3 && <=1 - , yaml ==0.8.10.* + , yaml >= 0.8 && < 0.9 default-language: Haskell2010 @@ -76,13 +76,13 @@ type : exitcode-stdio-1.0 hs-source-dirs : spec main-is : Spec.hs - build-depends : base >= 4.4 && <4.8 + build-depends : base >= 4.4 && <4.9 , base-compat == 0.6.* , hspec == 2.1.* , hspec-expectations == 0.6.* , text , dotenv == 0.1.* - , transformers == 0.3.* + , transformers >= 0.3 && < 0.5 , octohat other-modules: Network.Octohat.TestData, Network.Octohat.TestUtil diff --git a/src/Network/Octohat/Internal.hs b/src/Network/Octohat/Internal.hs --- a/src/Network/Octohat/Internal.hs +++ b/src/Network/Octohat/Internal.hs @@ -4,13 +4,17 @@ module Network.Octohat.Internal ( putRequestTo , getRequestTo + , resetPage + , getRequestPaginatedTo , postRequestTo , deleteRequestTo , composeEndpoint) where import Control.Error.Safe -import Control.Lens (set, view) +import Control.Lens (set, view, preview) import Control.Monad.Reader +import Control.Monad.State +import Data.Monoid import Data.Aeson import Data.List import Data.Text.Encoding (encodeUtf8) @@ -38,7 +42,6 @@ let opts'' = set (header "User-Agent") ["octohat v0.1"] opts' return opts'' - postRequestTo :: (ToJSON b, WT.Postable b, FromJSON a) => T.Text -> b -> GitHub a postRequestTo uri body = do opts <- requestOptions @@ -52,6 +55,37 @@ response <- liftIO $ getWith opts (T.unpack uri) checkForStatus response tryRight $ getResponseEntity response + +resetPage :: GitHub () +resetPage = modify $ \pn -> pn { page = 1 } + +getRequestPaginatedTo :: (Monoid a, FromJSON a) => T.Text -> GitHub a +getRequestPaginatedTo uri = do + opts <- requestOptions + let combinedResponse o acc = do + page_no <- gets page + per_page <- gets perPage + let ps = set (param "page") [T.pack $ show page_no] . set (param "per_page") [T.pack $ show per_page] + response <- liftIO $ getWith (ps o) (T.unpack uri) + checkForStatus response + let links' = Links + { linkNext = preview (responseLink "rel" "next") response + , linkLast = preview (responseLink "rel" "last") response + , linkFirst = preview (responseLink "rel" "first") response + , linkPrev = preview (responseLink "rel" "prev") response } + modify $ \pn -> pn { links = links' } + values <- tryRight $ getResponseEntity response + recurse' <- gets recurse + let acc' = acc <> values + if recurse' + then do + case linkNext links' of + Just _next -> do modify $ \pn -> pn { page = page_no + 1} + combinedResponse o acc' + Nothing -> return acc' + else return acc' + combinedResponse opts mempty + putRequestTo :: FromJSON a => T.Text -> GitHub a putRequestTo uri = do diff --git a/src/Network/Octohat/Members.hs b/src/Network/Octohat/Members.hs --- a/src/Network/Octohat/Members.hs +++ b/src/Network/Octohat/Members.hs @@ -17,6 +17,7 @@ , userForUsername , repoForReponame , addPublicKey + , resetPage ) where import Network.Octohat.Internal @@ -43,26 +44,26 @@ -- | Returns a list of members of an organization with the given name. membersForOrganization :: OrganizationName -- ^ The organization name -> GitHub [Member] -membersForOrganization (OrganizationName nameOfOrg) = getRequestTo (composeEndpoint ["orgs", nameOfOrg, "members"]) +membersForOrganization (OrganizationName nameOfOrg) = getRequestPaginatedTo (composeEndpoint ["orgs", nameOfOrg, "members"]) -- | Returns a list of members of a team with the given team ID. membersForTeam :: Integer -- ^ The team ID -> GitHub [Member] -membersForTeam idOfTeam = getRequestTo (composeEndpoint ["teams", T.pack $ show idOfTeam, "members"]) +membersForTeam idOfTeam = getRequestPaginatedTo (composeEndpoint ["teams", T.pack $ show idOfTeam, "members"]) -- | Returns a list of repos of a team with the given team ID. reposForTeam :: Integer -- ^ The team ID -> GitHub [Repo] -reposForTeam idOfTeam = getRequestTo (composeEndpoint ["teams", T.pack $ show idOfTeam, "repos"]) +reposForTeam idOfTeam = getRequestPaginatedTo (composeEndpoint ["teams", T.pack $ show idOfTeam, "repos"]) -- | Returns a list of teams for the organization with the given name teamsForOrganization :: OrganizationName -- ^ The organization name -> GitHub [Team] -teamsForOrganization (OrganizationName nameOfOrg) = getRequestTo (composeEndpoint ["orgs", nameOfOrg, "teams"]) +teamsForOrganization (OrganizationName nameOfOrg) = getRequestPaginatedTo (composeEndpoint ["orgs", nameOfOrg, "teams"]) -- | Returns a list of all organizations for the user organizations :: GitHub [Organization] -organizations = getRequestTo (composeEndpoint ["user", "orgs"]) +organizations = getRequestPaginatedTo (composeEndpoint ["user", "orgs"]) -- | Adds a member to a team, might invite or add the member. Refer to 'StatusInTeam' addMemberToTeam :: T.Text -- ^ The GitHub username to add to a team @@ -89,7 +90,7 @@ -- | Returns the public keys of the user with the given name publicKeysForUser :: T.Text -- ^ GitHub username -> GitHub [PublicKey] -publicKeysForUser nameOfUser = getRequestTo (composeEndpoint ["users", nameOfUser, "keys"]) +publicKeysForUser nameOfUser = getRequestPaginatedTo (composeEndpoint ["users", nameOfUser, "keys"]) -- | Finds a user ID given their username userForUsername :: T.Text -- ^ GitHub username diff --git a/src/Network/Octohat/Types.hs b/src/Network/Octohat/Types.hs --- a/src/Network/Octohat/Types.hs +++ b/src/Network/Octohat/Types.hs @@ -19,11 +19,14 @@ , GitHubReturnStatus(..) , DidAddKey(..) , AddPublicKeyRequest(..) + , Links(..) + , Pagination(..) , runGitHub , runGitHub' , GitHub) where import Control.Applicative import Control.Monad.Reader (ReaderT(..)) +import Control.Monad.State (StateT(..), evalStateT) import Control.Monad.Trans.Either import Data.Aeson import Data.Aeson.TH @@ -203,14 +206,24 @@ -- Team name and the Organization name are both strings and may be confused newtype TeamName = TeamName { unTeamName :: T.Text } deriving Show + +-- | Links are used in the Pagination object +data Links = Links { linkNext :: Maybe Link, linkLast :: Maybe Link + , linkFirst :: Maybe Link, linkPrev :: Maybe Link } deriving Show + +-- | Pagination options that can be set, including the page number, and the per_page +data Pagination = Pagination { perPage :: Int, page :: Int, links :: Links, recurse :: Bool } deriving Show +defPagination :: Pagination +defPagination = Pagination 30 1 (Links Nothing Nothing Nothing Nothing) True + -- | The monad transformer where all operations run. Supports initial configuration -- through a Reader monad and the possibility of failure through Either -type GitHub = EitherT GitHubReturnStatus (ReaderT BearerToken IO) +type GitHub = EitherT GitHubReturnStatus (ReaderT BearerToken (StateT Pagination IO)) -- | Executes a computation built within the GitHub monad returning an Either within -- the IO data type using the provided token runGitHub' :: GitHub a -> BearerToken -> IO (Either GitHubReturnStatus a) -runGitHub' comp = runReaderT (runEitherT comp) +runGitHub' comp token = evalStateT (runReaderT (runEitherT comp) token) defPagination -- | Executes a computation built within the GitHub monad returning an Either within -- the IO data type. Reads an API token from an environment variable named GITHUB_TOKEN