github 0.5.0 → 0.6.0

raw patch · 7 files changed

+106/−26 lines, 7 filesnew-uploaderPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Github/Data/Definitions.hs +2/−2
• Github/Issues.hs +2/−0
• Github/Issues/Comments.hs +9/−0
• Github/Issues/Milestones.hs +8/−1
• Github/Private.hs +72/−15
• Github/Repos.hs +6/−1
• github.cabal +7/−7

@@ -178,7 +178,7 @@ data Issue = Issue {    issueClosedAt :: Maybe GithubDate   ,issueUpdatedAt :: GithubDate-  ,issueHtmlUrl :: String+  ,issueHtmlUrl :: Maybe String   ,issueClosedBy :: Maybe GithubOwner   ,issueLabels :: [IssueLabel]   ,issueNumber :: Int@@ -188,7 +188,7 @@   ,issuePullRequest :: PullRequestReference   ,issueUrl :: String   ,issueCreatedAt :: GithubDate-  ,issueBody :: String+  ,issueBody :: Maybe String   ,issueState :: String   ,issueId :: Int   ,issueComments :: Int

@@ -31,6 +31,7 @@     | Ascending -- ^ Sort ascending.     | Descending -- ^ Sort descending. [default]     | Since UTCTime -- ^ Only issues created since the specified date and time.+    | PerPage Int -- ^ Download this many issues per query   -- | Details on a specific issue, given the repo owner and name, and the issue@@ -73,6 +74,7 @@     convert (Labels l)       = "labels=" ++ intercalate "," l     convert Ascending        = "direction=asc"     convert Descending       = "direction=desc"+    convert (PerPage n)      = "per_page=" ++ show n     convert (Since t)        =       "since=" ++ formatTime defaultTimeLocale "%FT%TZ" t 

@@ -3,6 +3,7 @@ module Github.Issues.Comments (  comment ,comments+,comments' ,module Github.Data ) where @@ -22,3 +23,11 @@ comments :: String -> String -> Int -> IO (Either Error [IssueComment]) comments user repoName issueNumber =   githubGet ["repos", user, repoName, "issues", show issueNumber, "comments"]++-- | All comments on an issue, by the issue's number, using authentication.+--+-- > comments' (GithubUser (user, password)) "thoughtbot" "paperclip" 635+comments' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error [IssueComment])+comments' auth user repoName issueNumber =+  githubGet' auth ["repos", user, repoName, "issues", show issueNumber, "comments"]+

@@ -2,6 +2,7 @@ -- <http://developer.github.com/v3/issues/milestones/>. module Github.Issues.Milestones (  milestones+,milestones' ,milestone ,module Github.Data ) where@@ -13,7 +14,13 @@ -- -- > milestones "thoughtbot" "paperclip" milestones :: String -> String -> IO (Either Error [Milestone])-milestones user repoName = githubGet ["repos", user, repoName, "milestones"]+milestones = milestones' Nothing++-- | All milestones in the repo, using authentication.+--+-- > milestones' (GithubUser (user, password)) "thoughtbot" "paperclip"+milestones' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Milestone])+milestones' auth user repoName = githubGet' auth ["repos", user, repoName, "milestones"]  -- | Details on a specific milestone, given it's milestone number. --

@@ -1,10 +1,13 @@ {-# LANGUAGE OverloadedStrings, StandaloneDeriving, DeriveDataTypeable #-}+{-# LANGUAGE CPP #-} module Github.Private where  import Github.Data+import Data.Char (isDigit) import Data.Aeson import Data.Attoparsec.ByteString.Lazy import Data.Data+import Data.Monoid import Control.Applicative import Data.List import Data.CaseInsensitive (mk)@@ -58,19 +61,57 @@ buildUrl :: [String] -> String buildUrl paths = "https://api.github.com/" ++ intercalate "/" paths -githubAPI :: (ToJSON a, Show a, FromJSON b, Show b) => BS.ByteString -> String -> Maybe GithubAuth -> Maybe a -> IO (Either Error b)+githubAPI :: (ToJSON a, Show a, FromJSON b, Show b) => BS.ByteString -> String+          -> Maybe GithubAuth -> Maybe a -> IO (Either Error b) githubAPI method url auth body = do-  result <- doHttps method url auth (Just encodedBody)-  return $ either (Left . HTTPConnectionError)-                  (parseJson . responseBody)-                  result-  where encodedBody = RequestBodyLBS $ encode $ toJSON body+  result <- doHttps method url auth (encodeBody body)+  case result of+      Left e     -> return (Left (HTTPConnectionError e))+      Right resp -> either Left (\x -> jsonResultToE (LBS.pack (show x))+                                                   (fromJSON x))+                          <$> handleBody resp -doHttps :: Method -> String -> Maybe GithubAuth -> Maybe (RequestBody (ResourceT IO)) -> IO (Either E.SomeException (Response LBS.ByteString))+  where+    encodeBody = Just . RequestBodyLBS . encode . toJSON++    handleBody resp = either (return . Left) (handleJson resp)+                             (parseJsonRaw (responseBody resp))++    -- This is an "escaping" version of "for", which returns (Right esc) if+    -- the value 'v' is Nothing; otherwise, it extracts the value from the+    -- Maybe, applies f, and return an IO (Either Error b).+    forE :: b -> Maybe a -> (a -> IO (Either Error b))+         -> IO (Either Error b)+    forE = flip . maybe . return . Right++    handleJson resp json@(Array ary) =+        -- Determine whether the output was paginated, and if so, we must+        -- recurse to obtain the subsequent pages, and append those result+        -- bodies to the current one.  The aggregate will then be parsed.+        forE json (lookup "Link" (responseHeaders resp)) $ \l ->+            forE json (getNextUrl (BS.unpack l)) $ \nu ->+                either (return . Left . HTTPConnectionError)+                       (\nextResp -> do+                             nextJson <- handleBody nextResp+                             return $ (\(Array x) -> Array (ary <> x))+                                          <$> nextJson)+                       =<< doHttps method nu auth Nothing+    handleJson _ json = return (Right json)++    getNextUrl l =+        if "rel=\"next\"" `isInfixOf` l+        then let s  = l+                 s' = Data.List.tail $ Data.List.dropWhile (/= '<') s+             in Just (Data.List.takeWhile (/= '>') s')+        else Nothing++doHttps :: Method -> String -> Maybe GithubAuth+        -> Maybe (RequestBody (ResourceT IO))+        -> IO (Either E.SomeException (Response LBS.ByteString)) doHttps method url auth body = do   let requestBody = fromMaybe (RequestBodyBS $ BS.pack "") body       requestHeaders = maybe [] getOAuth auth-      (Just uri) = parseUrl url+      Just uri = parseUrl url       request = uri { method = method                     , secure = True                     , port = 443@@ -97,16 +138,32 @@                                      BS.pack ("token " ++ token))]     getOAuth _ = []     getResponse request = withManager $ \manager -> httpLbs request manager+#if MIN_VERSION_http_conduit(1, 9, 0)+    successOrMissing s@(Status sci _) hs cookiejar+#else     successOrMissing s@(Status sci _) hs+#endif       | (200 <= sci && sci < 300) || sci == 404 = Nothing+#if MIN_VERSION_http_conduit(1, 9, 0)+      | otherwise = Just $ E.toException $ StatusCodeException s hs cookiejar+#else       | otherwise = Just $ E.toException $ StatusCodeException s hs+#endif -parseJson :: (FromJSON b, Show b) => LBS.ByteString -> Either Error b-parseJson jsonString =-  let parsed = parse (fromJSON <$> json) jsonString in+parseJsonRaw :: LBS.ByteString -> Either Error Value+parseJsonRaw jsonString =+  let parsed = parse json jsonString in   case parsed of-       Data.Attoparsec.ByteString.Lazy.Done _ jsonResult -> do-         case jsonResult of-              (Success s) -> Right s-              (Error e) -> Left $ JsonError $ e ++ " on the JSON: " ++ LBS.unpack jsonString+       Data.Attoparsec.ByteString.Lazy.Done _ jsonResult -> Right jsonResult        (Fail _ _ e) -> Left $ ParseError e++jsonResultToE :: Show b => LBS.ByteString -> Data.Aeson.Result b+              -> Either Error b+jsonResultToE jsonString result = case result of+    Success s -> Right s+    Error e   -> Left $ JsonError $+                 e ++ " on the JSON: " ++ LBS.unpack jsonString++parseJson :: (FromJSON b, Show b) => LBS.ByteString -> Either Error b+parseJson jsonString = either Left (jsonResultToE jsonString . fromJSON)+                              (parseJsonRaw jsonString)

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-} -- | The Github Repos API, as documented at -- <http://developer.github.com/v3/repos/> module Github.Repos (@@ -245,7 +246,11 @@                 -- non-existent repository              then return (Left (HTTPConnectionError                                 (E.toException-                                 (StatusCodeException status headers))))+                                 (StatusCodeException status headers+#if MIN_VERSION_http_conduit(1, 9, 0)+                                 (responseCookieJar resp)+#endif+                                 ))))              else return (Right ())   where     url = "https://api.github.com/repos/" ++ owner ++ "/" ++ repo

@@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version:             0.5.0+Version:             0.6.0  -- A short (one-line) description of the package. Synopsis:            Access to the Github API, v3.@@ -18,7 +18,7 @@                      like references and trees. This library wraps all of that, exposing a basic but                      Haskell-friendly set of functions and data structures.                      .-                     For more of an overview please see the README: <https://github.com/mike-burns/github/blob/master/README.md>+                     For more of an overview please see the README: <https://github.com/fpco/github/blob/master/README.md>  -- The license under which the package is released. License:             BSD3@@ -27,16 +27,16 @@ License-file:        LICENSE  -- The package author(s).-Author:              Mike Burns+Author:              Mike Burns, John Wiegley  -- An email address to which users can send suggestions, bug reports, -- and patches.-Maintainer:          mike@mike-burns.com+Maintainer:          johnw@fpcomplete.com -Homepage:            https://github.com/mike-burns/github+Homepage:            https://github.com/fpco/github  -- A copyright notice.-Copyright:           Copyright 2012-2013 Mike Burns+Copyright:           Copyright 2012-2013 Mike Burns, Copyright 2013 John Wiegley  Category:            Network APIs @@ -107,7 +107,7 @@  source-repository head   type: git-  location: git://github.com/mike-burns/github.git+  location: git://github.com/fpco/github.git   Library