Merge remote-tracking branch 'paulrzcz/master'

mike-burns · mike-burns · commit a62ccc0d5425 · 2012-06-10T19:43:31.000+03:00
diff --git a/Github/Gists.hs b/Github/Gists.hs
@@ -1,21 +1,35 @@
 -- | The gists API as described at <http://developer.github.com/v3/gists/>.
 module Github.Gists (
  gists
+,gists'
 ,gist
+,gist'
 ,module Github.Data
 ) where
 
 import Github.Data
 import Github.Private
 
+-- | The list of all gists created by the user 
+-- 
+-- > gists' (Just ("github-username", "github-password")) "mike-burns"
+gists' :: Maybe BasicAuth -> String -> IO (Either Error [Gist])
+gists' auth userName = githubGet' auth ["users", userName, "gists"]
+
 -- | The list of all public gists created by the user.
 --
 -- > gists "mike-burns"
 gists :: String -> IO (Either Error [Gist])
-gists userName = githubGet ["users", userName, "gists"]
+gists = gists' Nothing
+
+-- | A specific gist, given its id, with authentication credentials
+--
+-- > gist' (Just ("github-username", "github-password")) "225074"
+gist' :: Maybe BasicAuth -> String -> IO (Either Error Gist)
+gist' auth gistId = githubGet' auth ["gists", gistId]
 
 -- | A specific gist, given its id.
 --
 -- > gist "225074"
 gist :: String -> IO (Either Error Gist)
-gist gistId = githubGet ["gists", gistId]
+gist = gist' Nothing
diff --git a/Github/Issues.hs b/Github/Issues.hs
@@ -1,7 +1,9 @@
 -- | The issues API as described on <http://developer.github.com/v3/issues/>.
 module Github.Issues (
  issue
+,issue'
 ,issuesForRepo
+,issuesForRepo'
 ,IssueLimitation(..)
 ,module Github.Data
 ) where
@@ -30,21 +32,30 @@ data IssueLimitation =
     | Descending -- ^ Sort descending. [default]
     | Since UTCTime -- ^ Only issues created since the specified date and time.
 
+
+-- | Details on a specific issue, given the repo owner and name, and the issue
+-- number.'
+--
+-- > issue' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "462"
+issue' :: Maybe BasicAuth -> String -> String -> Int -> IO (Either Error Issue)
+issue' auth user repoName issueNumber =
+  githubGet' auth ["repos", user, repoName, "issues", show issueNumber]
+
 -- | Details on a specific issue, given the repo owner and name, and the issue
 -- number.
 --
 -- > issue "thoughtbot" "paperclip" "462"
 issue :: String -> String -> Int -> IO (Either Error Issue)
-issue user repoName issueNumber =
-  githubGet ["repos", user, repoName, "issues", show issueNumber]
+issue = issue' Nothing
 
 -- | All issues for a repo (given the repo owner and name), with optional
 -- restrictions as described in the @IssueLimitation@ data type.
 --
--- > issuesForRepo "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending]
-issuesForRepo :: String -> String -> [IssueLimitation] -> IO (Either Error [Issue])
-issuesForRepo user repoName issueLimitations =
-  githubGetWithQueryString
+-- > issuesForRepo' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending]
+issuesForRepo' :: Maybe BasicAuth -> String -> String -> [IssueLimitation] -> IO (Either Error [Issue])
+issuesForRepo' auth user repoName issueLimitations =
+  githubGetWithQueryString' 
+    auth
     ["repos", user, repoName, "issues"]
     (queryStringFromLimitations issueLimitations)
   where
@@ -64,3 +75,10 @@ issuesForRepo user repoName issueLimitations =
     convert Descending       = "direction=desc"
     convert (Since t)        =
       "since=" ++ formatTime defaultTimeLocale "%FT%TZ" t
+
+-- | All issues for a repo (given the repo owner and name), with optional
+-- restrictions as described in the @IssueLimitation@ data type.
+--
+-- > issuesForRepo "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending]
+issuesForRepo :: String -> String -> [IssueLimitation] -> IO (Either Error [Issue])
+issuesForRepo = issuesForRepo' Nothing
diff --git a/Github/Organizations.hs b/Github/Organizations.hs
@@ -1,21 +1,35 @@
 -- | The orgs API as described on <http://developer.github.com/v3/orgs/>.
 module Github.Organizations (
  publicOrganizationsFor
+,publicOrganizationsFor'
 ,publicOrganization
+,publicOrganization'
 ,module Github.Data
 ) where
 
 import Github.Data
 import Github.Private
 
+-- | The public organizations for a user, given the user's login, with authorization
+--
+-- > publicOrganizationsFor' (Just ("github-username", "github-password")) "mike-burns"
+publicOrganizationsFor' :: Maybe BasicAuth -> String -> IO (Either Error [SimpleOrganization])
+publicOrganizationsFor' auth userName = githubGet' auth ["users", userName, "orgs"]
+
 -- | The public organizations for a user, given the user's login.
 --
 -- > publicOrganizationsFor "mike-burns"
 publicOrganizationsFor :: String -> IO (Either Error [SimpleOrganization])
-publicOrganizationsFor userName = githubGet ["users", userName, "orgs"]
+publicOrganizationsFor = publicOrganizationsFor' Nothing
+
+-- | Details on a public organization. Takes the organization's login.
+--
+-- > publicOrganization' (Just ("github-username", "github-password")) "thoughtbot"
+publicOrganization' :: Maybe BasicAuth -> String -> IO (Either Error Organization)
+publicOrganization' auth organizationName = githubGet' auth ["orgs", organizationName]
 
 -- | Details on a public organization. Takes the organization's login.
 --
 -- > publicOrganization "thoughtbot"
 publicOrganization :: String -> IO (Either Error Organization)
-publicOrganization organizationName = githubGet ["orgs", organizationName]
+publicOrganization = publicOrganization' Nothing
diff --git a/Github/Private.hs b/Github/Private.hs
@@ -15,17 +15,23 @@ import qualified Control.Exception as E
 import Data.Maybe (fromMaybe)
 
 githubGet :: (FromJSON b, Show b) => [String] -> IO (Either Error b)
-githubGet paths =
+githubGet = githubGet' Nothing
+
+githubGet' :: (FromJSON b, Show b) => Maybe BasicAuth -> [String] -> IO (Either Error b)
+githubGet' auth paths =
   githubAPI (BS.pack "GET")
             (buildUrl paths)
-            Nothing
+            auth
             (Nothing :: Maybe Value)
 
 githubGetWithQueryString :: (FromJSON b, Show b) => [String] -> String -> IO (Either Error b)
-githubGetWithQueryString paths queryString =
+githubGetWithQueryString = githubGetWithQueryString' Nothing
+
+githubGetWithQueryString' :: (FromJSON b, Show b) => Maybe BasicAuth -> [String] -> String -> IO (Either Error b)
+githubGetWithQueryString' auth paths queryString =
   githubAPI (BS.pack "GET")
             (buildUrl paths ++ "?" ++ queryString)
-            Nothing
+            auth
             (Nothing :: Maybe Value)
 
 githubPost :: (ToJSON a, Show a, FromJSON b, Show b) => BasicAuth -> [String] -> a -> IO (Either Error b)
diff --git a/Github/PullRequests.hs b/Github/PullRequests.hs
@@ -1,7 +1,11 @@
 -- | The pull requests API as documented at
 -- <http://developer.github.com/v3/pulls/>.
 module Github.PullRequests (
- pullRequestsFor
+ pullRequestsFor'
+,pullRequest'
+,pullRequestCommits'
+,pullRequestFiles'
+,pullRequestsFor
 ,pullRequest
 ,pullRequestCommits
 ,pullRequestFiles
@@ -11,33 +15,63 @@ module Github.PullRequests (
 import Github.Data
 import Github.Private
 
+-- | All pull requests for the repo, by owner and repo name.
+-- | With authentification
+--
+-- > pullRequestsFor' (Just ("github-username", "github-password")) "rails" "rails"
+pullRequestsFor' :: Maybe BasicAuth -> String -> String -> IO (Either Error [PullRequest])
+pullRequestsFor' auth userName repoName =
+  githubGet' auth ["repos", userName, repoName, "pulls"]
+
 -- | All pull requests for the repo, by owner and repo name.
 --
 -- > pullRequestsFor "rails" "rails"
 pullRequestsFor :: String -> String -> IO (Either Error [PullRequest])
-pullRequestsFor userName repoName =
-  githubGet ["repos", userName, repoName, "pulls"]
+pullRequestsFor = pullRequestsFor' Nothing
+
+-- | A detailed pull request, which has much more information. This takes the
+-- repo owner and name along with the number assigned to the pull request.
+-- | With authentification
+--
+-- > pullRequest' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 562
+pullRequest' :: Maybe BasicAuth -> String -> String -> Int -> IO (Either Error DetailedPullRequest)
+pullRequest' auth userName repoName number =
+  githubGet' auth ["repos", userName, repoName, "pulls", show number]
 
 -- | A detailed pull request, which has much more information. This takes the
 -- repo owner and name along with the number assigned to the pull request.
 --
 -- > pullRequest "thoughtbot" "paperclip" 562
 pullRequest :: String -> String -> Int -> IO (Either Error DetailedPullRequest)
-pullRequest userName repoName number =
-  githubGet ["repos", userName, repoName, "pulls", show number]
+pullRequest = pullRequest' Nothing
+
+-- | All the commits on a pull request, given the repo owner, repo name, and
+-- the number of the pull request.
+-- | With authentification
+--
+-- > pullRequestCommits' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688
+pullRequestCommits' :: Maybe BasicAuth -> String -> String -> Int -> IO (Either Error [Commit])
+pullRequestCommits' auth userName repoName number =
+  githubGet' auth ["repos", userName, repoName, "pulls", show number, "commits"]
 
 -- | All the commits on a pull request, given the repo owner, repo name, and
 -- the number of the pull request.
 --
 -- > pullRequestCommits "thoughtbot" "paperclip" 688
 pullRequestCommits :: String -> String -> Int -> IO (Either Error [Commit])
-pullRequestCommits userName repoName number =
-  githubGet ["repos", userName, repoName, "pulls", show number, "commits"]
+pullRequestCommits = pullRequestCommits' Nothing
 
+-- | The individual files that a pull request patches. Takes the repo owner and
+-- name, plus the number assigned to the pull request.
+-- | With authentification
+--
+-- > pullRequestFiles' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688
+pullRequestFiles' :: Maybe BasicAuth -> String -> String -> Int -> IO (Either Error [File])
+pullRequestFiles' auth userName repoName number =
+  githubGet' auth ["repos", userName, repoName, "pulls", show number, "files"]
 -- | The individual files that a pull request patches. Takes the repo owner and
 -- name, plus the number assigned to the pull request.
 --
 -- > pullRequestFiles "thoughtbot" "paperclip" 688
 pullRequestFiles :: String -> String -> Int -> IO (Either Error [File])
-pullRequestFiles userName repoName number =
-  githubGet ["repos", userName, repoName, "pulls", show number, "files"]
+pullRequestFiles = pullRequestFiles' Nothing
diff --git a/Github/Users.hs b/Github/Users.hs
@@ -2,14 +2,22 @@
 -- <http://developer.github.com/v3/users/>.
 module Github.Users (
  userInfoFor
+,userInfoFor'
 ,module Github.Data
 ) where
 
 import Github.Data
 import Github.Private
 
+-- | The information for a single user, by login name.
+-- | With authentification
+--
+-- > userInfoFor' (Just ("github-username", "github-password")) "mike-burns"
+userInfoFor' :: Maybe BasicAuth -> String -> IO (Either Error DetailedOwner)
+userInfoFor' auth userName = githubGet' auth ["users", userName]
+
 -- | The information for a single user, by login name.
 --
 -- > userInfoFor "mike-burns"
 userInfoFor :: String -> IO (Either Error DetailedOwner)
-userInfoFor userName = githubGet ["users", userName]
+userInfoFor = userInfoFor' Nothing
diff --git a/samples/Issues/IssueReport/Issues.hs b/samples/Issues/IssueReport/Issues.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Main where
+
+import qualified Github.Issues as Github
+import qualified Data.ByteString as B
+import Report
+
+-- The example requires wl-pprint module "The Wadler/Leijen Pretty Printer"
+import Text.PrettyPrint.Leijen
+
+auth ::  Maybe (B.ByteString, B.ByteString)
+auth = Just ("yourgithub id", "somepassword")
+
+mkIssue :: ReportedIssue -> Doc
+mkIssue (Issue n t h) = hsep [
+        fill 5  (text ("#" ++ (show n))),
+        fill 50 (text t),
+        fill 5 (text (show h))]
+
+vissues :: ([Doc], [Doc], [Doc]) -> Doc
+vissues (x, y, z) = hsep [(vcat x), align (vcat y), align (vcat z)] 
+
+mkDoc :: Report -> Doc
+mkDoc (Report issues total) = vsep [
+                text "Report for the milestone",
+                (vsep . map mkIssue) issues, 
+                text ("Total hours : " ++ (show total) ++" hours")
+        ]
+
+mkFullDoc ::  [Github.Issue] -> Doc
+mkFullDoc = mkDoc . prepareReport
+
+-- The public repo is used as private are quite sensitive for this report
+-- 
+-- The main idea is to use labels like 1h, 2h etc for man-hour estimation of issues
+-- on private repos for development "on hire"
+--
+-- This tool is used to generate report on work done for the customer
+--
+main ::  IO ()
+main = do
+  let limitations = [Github.OnlyClosed, Github.MilestoneId 4]
+  possibleIssues <- Github.issuesForRepo' auth  "paulrzcz" "hquantlib" limitations
+  case possibleIssues of
+       (Left err) -> putStrLn $ "Error: " ++ show err
+       (Right issues) -> putDoc $ mkFullDoc issues 
diff --git a/samples/Issues/IssueReport/Report.hs b/samples/Issues/IssueReport/Report.hs
@@ -0,0 +1,61 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Report (
+    ReportedIssue (..),
+    Report (..),
+    prepareReport,
+    convertLabels
+    ) where
+
+import Text.Regex.Posix
+import qualified Github.Issues as Github
+
+data ReportedIssue = Issue {
+        riNumber :: Int,
+        riTitle  :: String,
+        riHour   :: Double
+    } deriving (Show)
+
+data Report = Report {
+        rIssues  :: [ReportedIssue],
+        rTotal   :: Double
+    } deriving (Show)
+
+convertIssue :: Github.Issue -> ReportedIssue
+convertIssue issue = Issue {
+        riNumber = Github.issueNumber issue,
+        riTitle  = Github.issueTitle  issue,
+        riHour   = convertLabels issue
+    }
+
+convertLabels ::  Github.Issue -> Double
+convertLabels = sumUp . toNames . Github.issueLabels
+
+prepareReport :: [Github.Issue] -> Report
+prepareReport issues = Report {
+        rIssues = reportedIssues,
+        rTotal  = foldl summator 0 reportedIssues
+    } where reportedIssues = map convertIssue issues
+            summator z x   = z + (riHour x)
+
+-- Helper functions to construct a sum of hour labels
+
+sumUp ::  [Maybe Double] -> Double
+sumUp = foldl s 0.0
+        where   s z Nothing = z
+                s z (Just x) = z+x
+
+toNames ::  [Github.IssueLabel] -> [Maybe Double]
+toNames = map (toValue . Github.labelName) 
+
+isValue :: String -> Bool
+isValue label = (label =~ ("^[0-9]h" :: String)) :: Bool
+
+convert ::  Read a => [Char] -> a
+convert label = read $ take len label
+        where   len = (length label) - 1
+
+toValue ::  Read a => String -> Maybe a
+toValue label
+   | isValue label      = Just (convert label)
+   | otherwise          = Nothing
+
