diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,34 +1,38 @@ -## Upcoming +# v1.1.3 -## 1.1.2 +* Add support for GHC 9.4 + 9.6 +* Drop support for GHC < 9 +* Set the `X-GitHub-Api-Version` header instead of setting the API version in the `Accept` header ([#33](https://github.com/brandonchinn178/github-rest/issues/33)) +# v1.1.2 + * Add support for `jwt-0.11.0` -## 1.1.1 +# v1.1.1 * Add support for `aeson-2.0.0.0` -## 1.1.0 +# v1.1.0 * Rename `GitHubState` to `GitHubSettings` * Remove `queryGitHubPage'` -- implement `queryGitHubPage` in `MonadGitHubREST` instead. * Expose `queryGitHubPageIO` if users want to manually implement `MonadGitHubREST` * Add `DecodeError` error -## 1.0.3 +# v1.0.3 * Fix goldens after GitHub changed documentation URL -## 1.0.2 +# v1.0.2 * Remove `MonadFail` constraint on `MonadGitHubREST` * Support `unliftio-core-0.2.0.0` -## 1.0.1 +# v1.0.1 Bundle test files in release tarball -## 1.0.0 +# v1.0.0 Initial release: diff --git a/LICENSE b/LICENSE deleted file mode 100644 --- a/LICENSE +++ /dev/null @@ -1,11 +0,0 @@ -Copyright 2019 LeapYear - -Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - -1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - -2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - -3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,11 @@ +Copyright © 2023-present Brandon Chinn + +Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. + +3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,7 +1,8 @@ # github-rest -![CircleCI](https://img.shields.io/circleci/build/github/LeapYear/github-rest) -![Hackage](https://img.shields.io/hackage/v/github-rest) +[![GitHub Actions](https://img.shields.io/github/actions/workflow/status/brandonchinn178/github-rest/ci.yml?branch=main)](https://github.com/brandonchinn178/github-rest/actions?query=branch%3Amain) +[![Codecov](https://codecov.io/gh/brandonchinn178/github-rest/branch/main/graph/badge.svg?token=8TErU2ntw9)](https://codecov.io/gh/brandonchinn178/github-rest) +[![Hackage](https://img.shields.io/hackage/v/github-rest)](https://hackage.haskell.org/package/github-rest) A package providing a more flexible interface to accessing the [GitHub API](https://developer.github.com/v3/). Endpoints are created using the `GHEndpoint` constructor and are executed with @@ -35,18 +36,18 @@ runGitHubT state $ do - -- Get information for the "master" branch + -- Get information for the "main" branch -- https://developer.github.com/v3/git/refs/#get-a-single-reference ref <- queryGitHub GHEndpoint { method = GET -- Colon-prefixed components in the endpoint will be interpolated by -- the values in 'endpointVals'. - -- In this case, "/repos/alice/my-project/git/refs/heads/master" + -- In this case, "/repos/alice/my-project/git/refs/heads/main" , endpoint = "/repos/:owner/:repo/git/refs/:ref" , endpointVals = [ "owner" := "alice" , "repo" := "my-project" - , "ref" := "heads/master" + , "ref" := "heads/main" ] , ghData = [] } diff --git a/github-rest.cabal b/github-rest.cabal --- a/github-rest.cabal +++ b/github-rest.cabal @@ -1,22 +1,22 @@ cabal-version: >= 1.10 --- This file has been generated from package.yaml by hpack version 0.34.4. +-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack name: github-rest -version: 1.1.2 +version: 1.1.3 synopsis: Query the GitHub REST API programmatically description: Query the GitHub REST API programmatically, which can provide a more flexible and clear interface than if all of the endpoints and their types were defined as Haskell values. category: GitHub -homepage: https://github.com/LeapYear/github-rest#readme -bug-reports: https://github.com/LeapYear/github-rest/issues -author: Brandon Chinn -maintainer: Brandon Chinn +homepage: https://github.com/brandonchinn178/github-rest#readme +bug-reports: https://github.com/brandonchinn178/github-rest/issues +author: Brandon Chinn +maintainer: Brandon Chinn license: BSD3 -license-file: LICENSE +license-file: LICENSE.md build-type: Simple extra-source-files: README.md @@ -27,7 +27,7 @@ source-repository head type: git - location: https://github.com/LeapYear/github-rest + location: https://github.com/brandonchinn178/github-rest library exposed-modules: @@ -42,26 +42,22 @@ Paths_github_rest hs-source-dirs: src - ghc-options: -Wall + ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances -Wunused-packages build-depends: - aeson >=1.1.2.0 && <2.1 - , base >=4.9 && <5 - , bytestring >=0.10.8.1 && <0.12 - , http-client >=0.5.13.1 && <0.8 - , http-client-tls >=0.3.5.3 && <0.4 - , http-types >=0.12.1 && <0.13 - , jwt >=0.9.0 && <0.12 - , mtl >=2.2.2 && <2.3 - , scientific >=0.3.6.2 && <0.4 - , text >=1.2.2.2 && <1.3 - , time >=1.8.0.2 && <1.12 - , transformers >=0.5.2.0 && <0.6 - , unliftio >=0.2.7.0 && <0.3 - , unliftio-core >=0.1.1.0 && <0.3 - if impl(ghc >= 8.0) - ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances - if impl(ghc < 8.8) - ghc-options: -Wnoncanonical-monadfail-instances + aeson <3 + , base >=4.15 && <5 + , bytestring <0.12 + , http-client >=0.5.13 && <0.8 + , http-client-tls <0.4 + , http-types >=0.11 && <0.13 + , jwt >=0.9 && <0.12 + , mtl <2.4 + , scientific <0.4 + , text <2.1 + , time <1.13 + , transformers <0.7 + , unliftio <0.3 + , unliftio-core <0.3 default-language: Haskell2010 test-suite github-rest-test @@ -76,30 +72,18 @@ Paths_github_rest hs-source-dirs: test - ghc-options: -Wall + ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances -Wunused-packages build-depends: - aeson >=1.1.2.0 && <2.1 + aeson >=1.5.6.0 , aeson-qq - , base >=4.9 && <5 - , bytestring >=0.10.8.1 && <0.12 + , base + , bytestring , github-rest - , http-client >=0.5.13.1 && <0.8 - , http-client-tls >=0.3.5.3 && <0.4 - , http-types >=0.12.1 && <0.13 - , jwt >=0.9.0 && <0.12 - , mtl >=2.2.2 && <2.3 - , scientific >=0.3.6.2 && <0.4 + , http-types + , mtl , tasty , tasty-golden , tasty-hunit - , tasty-quickcheck - , text >=1.2.2.2 && <1.3 - , time >=1.8.0.2 && <1.12 - , transformers >=0.5.2.0 && <0.6 - , unliftio >=0.2.7.0 && <0.3 - , unliftio-core >=0.1.1.0 && <0.3 - if impl(ghc >= 8.0) - ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances - if impl(ghc < 8.8) - ghc-options: -Wnoncanonical-monadfail-instances + , tasty-quickcheck >=0.8.1 + , text default-language: Haskell2010 diff --git a/src/GitHub/REST.hs b/src/GitHub/REST.hs --- a/src/GitHub/REST.hs +++ b/src/GitHub/REST.hs @@ -1,8 +1,8 @@ {-# LANGUAGE CPP #-} -{- | +{-| Module : GitHub.REST -Maintainer : Brandon Chinn +Maintainer : Brandon Chinn Stability : experimental Portability : portable @@ -59,18 +59,17 @@ {- HTTP exception handling -} -{- | Handle 422 exceptions thrown by the GitHub REST API. - - Most client errors are 422, since we should always be sending valid JSON. If an endpoint - throws different error codes, use githubTry'. - - https://developer.github.com/v3/#client-errors --} -githubTry :: MonadUnliftIO m => m a -> m (Either Value a) +-- | Handle 422 exceptions thrown by the GitHub REST API. +-- +-- Most client errors are 422, since we should always be sending valid JSON. If an endpoint +-- throws different error codes, use githubTry'. +-- +-- https://developer.github.com/v3/#client-errors +githubTry :: (MonadUnliftIO m) => m a -> m (Either Value a) githubTry = githubTry' status422 -- | Handle the given exception thrown by the GitHub REST API. -githubTry' :: MonadUnliftIO m => Status -> m a -> m (Either Value a) +githubTry' :: (MonadUnliftIO m) => Status -> m a -> m (Either Value a) githubTry' status = handleJust statusException (return . Left) . fmap Right where statusException (HttpExceptionRequest _ (StatusCodeException r body)) @@ -80,7 +79,7 @@ {- Aeson helpers -} -- | Get the given key from the Value, erroring if it doesn't exist. -(.:) :: FromJSON a => Value -> Text -> a +(.:) :: (FromJSON a) => Value -> Text -> a (.:) v key = either error id $ parseEither parseObject v where parseObject = withObject "parseObject" (`parseField` fromText key) diff --git a/src/GitHub/REST/Auth.hs b/src/GitHub/REST/Auth.hs --- a/src/GitHub/REST/Auth.hs +++ b/src/GitHub/REST/Auth.hs @@ -2,9 +2,9 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{- | +{-| Module : GitHub.REST.Auth -Maintainer : Brandon Chinn +Maintainer : Brandon Chinn Stability : experimental Portability : portable diff --git a/src/GitHub/REST/Endpoint.hs b/src/GitHub/REST/Endpoint.hs --- a/src/GitHub/REST/Endpoint.hs +++ b/src/GitHub/REST/Endpoint.hs @@ -2,9 +2,9 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -{- | +{-| Module : GitHub.REST.Endpoint -Maintainer : Brandon Chinn +Maintainer : Brandon Chinn Stability : experimental Portability : portable @@ -35,15 +35,15 @@ -- | A call to a GitHub API endpoint. data GHEndpoint = GHEndpoint { method :: StdMethod - , -- | The GitHub API endpoint, with colon-prefixed components that will be replaced; e.g. - -- @"\/users\/:username\/repos"@ - endpoint :: Text - , -- | Key-value pairs to replace colon-prefixed components in 'endpoint'; e.g. - -- @[ "username" := ("alice" :: Text) ]@ - endpointVals :: EndpointVals - , -- | Key-value pairs to send in the request body; e.g. - -- @[ "sort" := ("created" :: Text), "direction" := ("asc" :: Text) ]@ - ghData :: GitHubData + , endpoint :: Text + -- ^ The GitHub API endpoint, with colon-prefixed components that will be replaced; e.g. + -- @"\/users\/:username\/repos"@ + , endpointVals :: EndpointVals + -- ^ Key-value pairs to replace colon-prefixed components in 'endpoint'; e.g. + -- @[ "username" := ("alice" :: Text) ]@ + , ghData :: GitHubData + -- ^ Key-value pairs to send in the request body; e.g. + -- @[ "sort" := ("created" :: Text), "direction" := ("asc" :: Text) ]@ } -- | Return the endpoint path, populated by the values in 'endpointVals'. diff --git a/src/GitHub/REST/KeyValue.hs b/src/GitHub/REST/KeyValue.hs --- a/src/GitHub/REST/KeyValue.hs +++ b/src/GitHub/REST/KeyValue.hs @@ -2,9 +2,9 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} -{- | +{-| Module : GitHub.REST.KeyValue -Maintainer : Brandon Chinn +Maintainer : Brandon Chinn Stability : experimental Portability : portable diff --git a/src/GitHub/REST/Monad.hs b/src/GitHub/REST/Monad.hs --- a/src/GitHub/REST/Monad.hs +++ b/src/GitHub/REST/Monad.hs @@ -5,9 +5,9 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-} -{- | +{-| Module : GitHub.REST.Monad -Maintainer : Brandon Chinn +Maintainer : Brandon Chinn Stability : experimental Portability : portable @@ -71,13 +71,13 @@ {- GitHubSettings -} data GitHubSettings = GitHubSettings - { -- | The token to use to authenticate with the API. - token :: Maybe Token - , -- | The user agent to use when interacting with the API: https://developer.github.com/v3/#user-agent-required - userAgent :: ByteString - , -- | The media type will be sent as: application/vnd.github.VERSION+json. For the standard - -- API endpoints, "v3" should be sufficient here. See https://developer.github.com/v3/media/ - apiVersion :: ByteString + { token :: Maybe Token + -- ^ The token to use to authenticate with the API. + , userAgent :: ByteString + -- ^ The user agent to use when interacting with the API: https://developer.github.com/v3/#user-agent-required + , apiVersion :: ByteString + -- ^ The [version of the GitHub REST API](https://docs.github.com/en/rest/overview/api-versions) being used. + -- If left empty, GitHub will assume a default version. } {- GitHubManager -} @@ -93,22 +93,26 @@ ghManager <- newManager tlsManagerSettings return GitHubManager{..} -{- | Same as 'queryGitHubPage', except explicitly taking in 'GitHubManager' and running - in IO. - - Useful for implementing 'MonadGitHubREST' outside of 'GitHubT'. --} -queryGitHubPageIO :: FromJSON a => GitHubManager -> GHEndpoint -> IO (a, PageLinks) +-- | Same as 'queryGitHubPage', except explicitly taking in 'GitHubManager' and running +-- in IO. +-- +-- Useful for implementing 'MonadGitHubREST' outside of 'GitHubT'. +queryGitHubPageIO :: (FromJSON a) => GitHubManager -> GHEndpoint -> IO (a, PageLinks) queryGitHubPageIO GitHubManager{..} ghEndpoint = do let GitHubSettings{..} = ghSettings + let apiVersionHeader + | "" <- apiVersion = [] + | otherwise = [("X-GitHub-Api-Version", apiVersion)] + let request = (parseRequest_ $ Text.unpack $ ghUrl <> endpointPath ghEndpoint) { method = renderMethod ghEndpoint , requestHeaders = - [ (hAccept, "application/vnd.github." <> apiVersion <> "+json") + [ (hAccept, "application/vnd.github+json") , (hUserAgent, userAgent) ] + ++ apiVersionHeader ++ maybe [] ((: []) . (hAuthorization,) . fromToken) token , requestBody = RequestBodyLBS $ encode $ kvToValue $ ghData ghEndpoint , checkResponse = throwErrorStatusCodes @@ -160,22 +164,21 @@ , MonadTrans ) -instance MonadUnliftIO m => MonadUnliftIO (GitHubT m) where +instance (MonadUnliftIO m) => MonadUnliftIO (GitHubT m) where withRunInIO inner = GitHubT $ withRunInIO $ \run -> inner (run . unGitHubT) -instance MonadIO m => MonadGitHubREST (GitHubT m) where +instance (MonadIO m) => MonadGitHubREST (GitHubT m) where queryGitHubPage ghEndpoint = do manager <- GitHubT ask liftIO $ queryGitHubPageIO manager ghEndpoint -{- | Run the given 'GitHubT' action with the given token and user agent. - - The token will be sent with each API request -- see 'Token'. The user agent is also required for - each API request -- see https://developer.github.com/v3/#user-agent-required. --} -runGitHubT :: MonadIO m => GitHubSettings -> GitHubT m a -> m a +-- | Run the given 'GitHubT' action with the given token and user agent. +-- +-- The token will be sent with each API request -- see 'Token'. The user agent is also required for +-- each API request -- see https://developer.github.com/v3/#user-agent-required. +runGitHubT :: (MonadIO m) => GitHubSettings -> GitHubT m a -> m a runGitHubT settings action = do manager <- liftIO $ initGitHubManager settings (`runReaderT` manager) . unGitHubT $ action diff --git a/src/GitHub/REST/Monad/Class.hs b/src/GitHub/REST/Monad/Class.hs --- a/src/GitHub/REST/Monad/Class.hs +++ b/src/GitHub/REST/Monad/Class.hs @@ -1,9 +1,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE TypeApplications #-} -{- | +{-| Module : GitHub.REST.Monad.Class -Maintainer : Brandon Chinn +Maintainer : Brandon Chinn Stability : experimental Portability : portable @@ -34,38 +34,37 @@ import GitHub.REST.Endpoint import GitHub.REST.PageLinks (PageLinks (..)) -{- | A type class for monads that can query the GitHub REST API. - - Example: - - > -- create the "foo" branch - > queryGitHub GHEndpoint - > { method = POST - > , endpoint = "/repos/:owner/:repo/git/refs" - > , endpointVals = - > [ "owner" := "alice" - > , "repo" := "my-project" - > ] - > , ghData = - > [ "ref" := "refs/heads/foo" - > , "sha" := "1234567890abcdef" - > ] - > } - - It's recommended that you create functions for the API endpoints you're using: - - > deleteBranch branch = queryGitHub GHEndpoint - > { method = DELETE - > , endpoint = "/repos/:owner/:repo/git/refs/:ref" - > , endpointVals = - > [ "owner" := "alice" - > , "repo" := "my-project" - > , "ref" := "heads/" <> branch - > ] - > , ghData = [] - > } --} -class Monad m => MonadGitHubREST m where +-- | A type class for monads that can query the GitHub REST API. +-- +-- Example: +-- +-- > -- create the "foo" branch +-- > queryGitHub GHEndpoint +-- > { method = POST +-- > , endpoint = "/repos/:owner/:repo/git/refs" +-- > , endpointVals = +-- > [ "owner" := "alice" +-- > , "repo" := "my-project" +-- > ] +-- > , ghData = +-- > [ "ref" := "refs/heads/foo" +-- > , "sha" := "1234567890abcdef" +-- > ] +-- > } +-- +-- It's recommended that you create functions for the API endpoints you're using: +-- +-- > deleteBranch branch = queryGitHub GHEndpoint +-- > { method = DELETE +-- > , endpoint = "/repos/:owner/:repo/git/refs/:ref" +-- > , endpointVals = +-- > [ "owner" := "alice" +-- > , "repo" := "my-project" +-- > , "ref" := "heads/" <> branch +-- > ] +-- > , ghData = [] +-- > } +class (Monad m) => MonadGitHubREST m where {-# MINIMAL queryGitHubPage #-} -- | Query GitHub, returning @(payload, links)@ if successful, where @payload@ is the @@ -75,10 +74,10 @@ -- -- Errors on network connection failures, if GitHub sent back an error message, or if the response -- could not be decoded as JSON. Use `githubTry` if you wish to handle GitHub errors. - queryGitHubPage :: FromJSON a => GHEndpoint -> m (a, PageLinks) + queryGitHubPage :: (FromJSON a) => GHEndpoint -> m (a, PageLinks) -- | 'queryGitHubPage', except ignoring pagination links. - queryGitHub :: FromJSON a => GHEndpoint -> m a + queryGitHub :: (FromJSON a) => GHEndpoint -> m a queryGitHub = fmap fst . queryGitHubPage -- | Repeatedly calls 'queryGitHubPage' for each page returned by GitHub and concatenates the @@ -98,16 +97,16 @@ {- Instances for common monad transformers -} -instance MonadGitHubREST m => MonadGitHubREST (ReaderT r m) where +instance (MonadGitHubREST m) => MonadGitHubREST (ReaderT r m) where queryGitHubPage = lift . queryGitHubPage -instance MonadGitHubREST m => MonadGitHubREST (ExceptT e m) where +instance (MonadGitHubREST m) => MonadGitHubREST (ExceptT e m) where queryGitHubPage = lift . queryGitHubPage -instance MonadGitHubREST m => MonadGitHubREST (IdentityT m) where +instance (MonadGitHubREST m) => MonadGitHubREST (IdentityT m) where queryGitHubPage = lift . queryGitHubPage -instance MonadGitHubREST m => MonadGitHubREST (MaybeT m) where +instance (MonadGitHubREST m) => MonadGitHubREST (MaybeT m) where queryGitHubPage = lift . queryGitHubPage instance (Monoid w, MonadGitHubREST m) => MonadGitHubREST (Lazy.RWST r w s m) where @@ -116,10 +115,10 @@ instance (Monoid w, MonadGitHubREST m) => MonadGitHubREST (Strict.RWST r w s m) where queryGitHubPage = lift . queryGitHubPage -instance MonadGitHubREST m => MonadGitHubREST (Lazy.StateT s m) where +instance (MonadGitHubREST m) => MonadGitHubREST (Lazy.StateT s m) where queryGitHubPage = lift . queryGitHubPage -instance MonadGitHubREST m => MonadGitHubREST (Strict.StateT s m) where +instance (MonadGitHubREST m) => MonadGitHubREST (Strict.StateT s m) where queryGitHubPage = lift . queryGitHubPage instance (Monoid w, MonadGitHubREST m) => MonadGitHubREST (Lazy.WriterT w m) where diff --git a/src/GitHub/REST/PageLinks.hs b/src/GitHub/REST/PageLinks.hs --- a/src/GitHub/REST/PageLinks.hs +++ b/src/GitHub/REST/PageLinks.hs @@ -14,10 +14,9 @@ import Data.Text (Text) import qualified Data.Text as Text -{- | Helper type for GitHub pagination. - - https://developer.github.com/v3/guides/traversing-with-pagination/ --} +-- | Helper type for GitHub pagination. +-- +-- https://developer.github.com/v3/guides/traversing-with-pagination/ data PageLinks = PageLinks { pageFirst :: Maybe Text , pagePrev :: Maybe Text @@ -55,12 +54,11 @@ "last" -> pageLinks{pageLast = Just url} _ -> error $ "Unknown rel in page link: " ++ show link -{- | Parse a single page link, like: - - ; rel="next" - - Returns ("next", "/search/code?q=addClass+user%3Amozilla&page=2") --} +-- | Parse a single page link, like: +-- +-- ; rel="next" +-- +-- Returns ("next", "/search/code?q=addClass+user%3Amozilla&page=2") parsePageLink :: Text -> (Text, Text) parsePageLink link = fromMaybe (error $ "Unknown page link: " ++ show link) $ do (linkUrl, linkRel) <- case split ";" link of diff --git a/test/Query.hs b/test/Query.hs --- a/test/Query.hs +++ b/test/Query.hs @@ -34,10 +34,10 @@ GitHubSettings { token = Nothing , userAgent = "github-rest" - , apiVersion = "v3" + , apiVersion = "" } -showResult :: Monad m => m (Either Value Value) -> m ByteString +showResult :: (Monad m) => m (Either Value Value) -> m ByteString showResult m = m >>= \case Right v -> error $ "Got back invalid result: " ++ show v