Sort PR table by repository.

github-tools.cabal

@@ -94,7 +94,6 @@ library
       PullRequestInfo
       PullStatus
       Requests
-      Review
   ghc-options:
       -Wall
   build-depends:
@@ -113,7 +112,6 @@ library
     , QuickCheck
     , quickcheck-text
     , tabular
-    , tagsoup
     , text
     , time
     , unordered-containers
@@ -131,6 +129,7 @@ executable hub-pulls
     , bytestring
     , github            >= 0.15.0
     , github-tools
+    , text
   hs-source-dirs:      tools
   default-language:    Haskell2010
 

src/PullRequestInfo.hs

@@ -1,11 +1,15 @@
+{-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE OverloadedStrings #-}
 module PullRequestInfo where
 
 import           Control.Monad         (join)
-import qualified Data.Maybe            as Maybe
+import           Data.Aeson            (FromJSON, ToJSON)
+import qualified Data.List             as List
+import           Data.Monoid           ((<>))
+import           Data.Text             (Text)
 import qualified Data.Text             as Text
 import           Data.Time.Clock       (UTCTime, diffUTCTime)
-import qualified GitHub
-import qualified Review
+import           GHC.Generics          (Generic)
 import           Text.Html             (prettyHtml, toHtml)
 import           Text.Tabular          (Header (..), Properties (..),
                                         Table (..))
@@ -14,18 +18,35 @@ import qualified Text.Tabular.Html     as Html
 
 
 data PullRequestInfo = PullRequestInfo
-  { repoName     :: GitHub.Name GitHub.Repo
-  , reviewStatus :: [Review.Status]
-  , pullRequest  :: GitHub.PullRequest
+  { prRepoName  :: Text
+    -- ^ The repository for which the pull request is.
+  , prNumber    :: Int
+    -- ^ The assigned pull request issue number.
+  , prUser      :: Text
+    -- ^ The user who proposed this PR.
+  , prBranch    :: Text
+    -- ^ The branch name from which the pull request came.
+  , prCreated   :: UTCTime
+    -- ^ Creation time of pull request. I.e. when it was proposed.
+  , prTitle     :: Text
+    -- ^ Title of pull request.
+  , prReviewers :: [Text]
+    -- ^ The list of pull request reviewers (assignees).
+  , prState     :: Text
   }
+  deriving (Ord, Eq, Generic)
 
+instance ToJSON PullRequestInfo
+instance FromJSON PullRequestInfo
 
-formatPR :: Bool -> UTCTime -> [[PullRequestInfo]] -> String
-formatPR False now = AsciiArt.render id id id . prToTable now
-formatPR True  now = prettyHtml . Html.render toHtml toHtml toHtml . prToTable now
 
+formatPR :: Bool -> UTCTime -> [[PullRequestInfo]] -> Text
+formatPR False now = Text.pack . AsciiArt.render Text.unpack Text.unpack Text.unpack . prToTable now
+formatPR True  now = Text.pack . prettyHtml . Html.render textHtml textHtml textHtml . prToTable now
+  where textHtml = toHtml . Text.unpack
 
-prToTable :: UTCTime -> [[PullRequestInfo]] -> Table String String String
+
+prToTable :: UTCTime -> [[PullRequestInfo]] -> Table Text Text Text
 prToTable now prss = Table rowNames columnNames rows
   where
     rowNames = Group SingleLine
@@ -34,40 +55,24 @@ prToTable now prss = Table rowNames columnNames rows
       $ prss
 
     getRowName pr =
-      let repo num = getRepoName pr ++ " " ++ num in
-      repo . show . GitHub.pullRequestNumber . pullRequest $ pr
-
-    getRepoName = Text.unpack . GitHub.untagName . repoName
+      let repo num = prRepoName pr <> " " <> num in
+      repo . Text.pack . show . prNumber $ pr
 
     columnNames =  Group SingleLine
       [ Header "branch"
       , Header "age"
       , Header "title"
-      , Header "mergeable"
-      , Header "mergeable_state"
+      , Header "state"
       , Header "review_status"
       ]
 
-    rows = map (\pr ->
-      [ getPrBranch         $ pullRequest pr
-      , getPrAge            $ pullRequest pr
-      , getPrTitle          $ pullRequest pr
-      , getPrMergeable      $ pullRequest pr
-      , getPrMergeableState $ pullRequest pr
-      , show $ reviewStatus pr
-      ]) $ join prss
-
-    getPrTitle = Text.unpack . GitHub.pullRequestTitle
-    getPrMergeable = show . Maybe.fromMaybe False . GitHub.pullRequestMergeable
-    getPrMergeableState = show . GitHub.pullRequestMergeableState
-
-    getPrBranch =
-      Text.unpack
-        . GitHub.pullRequestCommitLabel
-        . GitHub.pullRequestHead
-
-    getPrAge =
-      (++ "d") . show . diffInDays now . GitHub.pullRequestCreatedAt
+    rows = map (flip map
+      [ \pr -> prUser pr <> "/" <> prBranch pr
+      , Text.pack . (++ "d") . show . diffInDays now . prCreated
+      , prTitle
+      , prState
+      , Text.pack . List.intercalate "," . map Text.unpack . prReviewers
+      ] . flip ($)) $ join prss
 
 
 diffInDays :: UTCTime -> UTCTime -> Int

src/PullStatus.hs

@@ -1,18 +1,25 @@
-module PullStatus (getPullStatus) where
+{-# LANGUAGE OverloadedStrings #-}
+module PullStatus
+  ( getPullStatus
+  , getPullInfos
+  , showPullInfos
+  ) where
 
 import           Control.Applicative     ((<$>))
 import qualified Control.Monad.Parallel  as Parallel
+import qualified Data.List               as List
+import           Data.Text               (Text)
+import qualified Data.Text               as Text
 import           Data.Time.Clock         (getCurrentTime)
 import qualified Data.Vector             as V
 import qualified GitHub
 import qualified GitHub.Data.Id          as GitHub
 import           Network.HTTP.Client     (Manager, newManager)
 import           Network.HTTP.Client.TLS (tlsManagerSettings)
 
-import           PullRequestInfo         (PullRequestInfo (PullRequestInfo))
+import           PullRequestInfo         (PullRequestInfo (..))
 import qualified PullRequestInfo
 import           Requests
-import qualified Review
 
 
 getFullPr
@@ -35,16 +42,36 @@ getPrInfo
   -> GitHub.Name GitHub.Owner
   -> GitHub.Name GitHub.Repo
   -> GitHub.SimplePullRequest
-  -> IO ([Review.Status], GitHub.PullRequest)
+  -> IO ([Text], GitHub.PullRequest)
 getPrInfo auth mgr ownerName repoName pr = do
-  -- Use assignees as the initial approvals list, all responses unknown.
   let assignees = V.toList $ GitHub.simplePullRequestAssignees pr
-  let initApprovals = map (Review.Status Review.Unknown . GitHub.untagName . GitHub.simpleUserLogin) assignees
-  -- Fetch and parse HTML pages for this PR.
-  approvals <- Review.approvalsFromHtml initApprovals <$> Review.fetchHtml mgr pr
+  let reviewers = map (GitHub.untagName . GitHub.simpleUserLogin) assignees
   -- Get more information that is only in the PullRequest response.
   fullPr <- getFullPr auth mgr ownerName repoName pr
-  return (approvals, fullPr)
+  return (reviewers, fullPr)
+
+
+makePullRequestInfo
+  :: GitHub.Name GitHub.Repo
+  -> ([Text], GitHub.PullRequest)
+  -> PullRequestInfo
+makePullRequestInfo repoName (reviewers, pr) = PullRequestInfo
+  { prRepoName  = GitHub.untagName repoName
+  , prNumber    = GitHub.pullRequestNumber pr
+  , prUser      = user
+  , prBranch    = Text.tail branch
+  , prCreated   = GitHub.pullRequestCreatedAt pr
+  , prTitle     = GitHub.pullRequestTitle pr
+  , prReviewers = reviewers
+  , prState     = showMergeableState $ GitHub.pullRequestMergeableState pr
+  }
+  where
+    (user, branch) = Text.breakOn ":" . GitHub.pullRequestCommitLabel . GitHub.pullRequestHead $ pr
+
+    showMergeableState GitHub.StateClean    = "clean"
+    showMergeableState GitHub.StateDirty    = "dirty"
+    showMergeableState GitHub.StateUnknown  = "unknown"
+    showMergeableState GitHub.StateUnstable = "unstable"
 
 
 getPrsForRepo
@@ -59,25 +86,36 @@ getPrsForRepo auth mgr ownerName repoName = do
 
   prInfos <- Parallel.mapM (getPrInfo auth mgr ownerName repoName) simplePRs
 
-  return $ map (uncurry $ PullRequestInfo repoName) prInfos
+  return $ map (makePullRequestInfo repoName) prInfos
 
 
-getPullStatus
+getPullInfos
   :: GitHub.Name GitHub.Organization
   -> GitHub.Name GitHub.Owner
-  -> Bool
   -> Maybe GitHub.Auth
-  -> IO String
-getPullStatus orgName ownerName wantHtml auth = do
+  -> IO [[PullRequestInfo]]
+getPullInfos orgName ownerName auth = do
   -- Initialise HTTP manager so we can benefit from keep-alive connections.
   mgr <- newManager tlsManagerSettings
 
   -- Get repo list.
   repos <- V.toList <$> request auth mgr (GitHub.organizationReposR orgName GitHub.RepoPublicityAll GitHub.FetchAll)
   let repoNames = map GitHub.repoName repos
 
-  infos <- Parallel.mapM (getPrsForRepo auth mgr ownerName) repoNames
+  filter (not . null) . List.sort <$> Parallel.mapM (getPrsForRepo auth mgr ownerName) repoNames
+
 
+showPullInfos :: Bool -> [[PullRequestInfo]] -> IO Text
+showPullInfos wantHtml infos =
   -- Pretty-print table with information.
-  now <- getCurrentTime
-  return $ PullRequestInfo.formatPR wantHtml now infos
+  flip (PullRequestInfo.formatPR wantHtml) infos <$> getCurrentTime
+
+
+getPullStatus
+  :: GitHub.Name GitHub.Organization
+  -> GitHub.Name GitHub.Owner
+  -> Bool
+  -> Maybe GitHub.Auth
+  -> IO Text
+getPullStatus orgName ownerName wantHtml auth =
+  getPullInfos orgName ownerName auth >>= showPullInfos wantHtml

tools/hub-pulls.hs

@@ -3,6 +3,7 @@ module Main (main) where
 
 import           Control.Applicative   ((<$>))
 import qualified Data.ByteString.Char8 as BS8
+import qualified Data.Text             as Text
 import qualified GitHub
 import           System.Environment    (getEnv, lookupEnv)
 
@@ -17,4 +18,4 @@ main = do
   -- Check if we need to produce HTML or ASCII art.
   wantHtml <- (/= Nothing) <$> lookupEnv "GITHUB_WANT_HTML"
 
-  putStrLn =<< getPullStatus "TokTok" "TokTok" wantHtml auth
+  putStrLn . Text.unpack =<< getPullStatus "TokTok" "TokTok" wantHtml auth