packages feed

github-0.28: spec/GitHub/CommitsSpec.hs

{-# LANGUAGE OverloadedStrings #-}
module GitHub.CommitsSpec where

import GitHub.Auth                    (Auth (..))
import GitHub.Endpoints.Repos.Commits (commitSha, commitsForR, diffR, mkCommitName, FetchCount (..))
import GitHub.Request                 (github)

import Control.Monad      (forM_)
import Data.Either.Compat (isRight)
import Data.List          (nub, sort)
import Data.String        (fromString)
import System.Environment (lookupEnv)
import Test.Hspec         (Spec, describe, it, pendingWith, shouldBe,
                           shouldSatisfy)

import qualified Data.Vector as V

fromRightS :: Show a => Either a b -> b
fromRightS (Right b) = b
fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a

withAuth :: (Auth -> IO ()) -> IO ()
withAuth action = do
  mtoken <- lookupEnv "GITHUB_TOKEN"
  case mtoken of
    Nothing    -> pendingWith "no GITHUB_TOKEN"
    Just token -> action (OAuth $ fromString token)

spec :: Spec
spec = do
  describe "commitsFor" $ do
    it "works" $ withAuth $ \auth -> do
      cs <- github auth commitsForR "haskell-github" "github" FetchAll
      cs `shouldSatisfy` isRight
      V.length (fromRightS cs) `shouldSatisfy` (> 300)

    -- Page size is 30, so we get 60 commits
    it "limits the response" $ withAuth $ \auth -> do
      cs <- github auth commitsForR "haskell-github" "github" (FetchAtLeast 40)
      cs `shouldSatisfy` isRight
      let cs' = fromRightS cs
      V.length cs' `shouldSatisfy` (< 70)
      let hashes = sort $ map commitSha $ V.toList cs'
      hashes `shouldBe` nub hashes

  describe "diff" $ do
    it "works" $ withAuth $ \auth -> do
      cs <- github auth commitsForR "haskell-github" "github" (FetchAtLeast 30)
      cs `shouldSatisfy` isRight
      let commits = take 10 . V.toList . fromRightS $ cs
      let pairs = zip commits $ drop 1 commits
      forM_ pairs $ \(a, b) -> do
        d <- github auth diffR "haskell-github" "github" (commitSha a) (commitSha b)
        d `shouldSatisfy` isRight

    it "issue #155" $ withAuth $ \auth -> do
      d <- github auth diffR "nomeata" "codespeed" (mkCommitName "ghc") (mkCommitName "tobami:master")
      d `shouldSatisfy` isRight

    -- diff that includes a commit where a submodule is removed
    it "issue #339" $ withAuth $ \auth -> do
      d <- github auth diffR "scott-fleischman" "repo-remove-submodule" "d03c152482169d809be9b1eab71dcf64d7405f76" "42cfd732b20cd093534f246e630b309186eb485d"
      d `shouldSatisfy` isRight