Merge pull request #71 from mattpolzin/graph-completed

Graph completed PR reviews with new --completed flag.

README.md

@@ -163,6 +163,8 @@ Running `harmony list <team>` will list the members of the given GitHub Team.
 ### Graph
 Running `harmony graph <team>` will graph the relative review workload of each of the members of the given GitHub Team.
 
+You can optionally graph completed PR reviews with the `--completed` flag as well, though these are not considered for Harmony's weighting algorithm for review workload.
+
 ### Config
 Running `harmony config <property>` will read the given configuration property. `harmony config <property> <value>` will set the configuration property.
 

harmony.ipkg

@@ -1,5 +1,5 @@
 package harmony
-version = 1.2.0
+version = 1.3.0
 authors = "Mathew Polzin"
 license = "MIT"
 -- brief =

package.json

@@ -1,6 +1,6 @@
 {
   "name": "@mattpolzin/harmony",
-  "version": "1.2.0",
+  "version": "1.3.0",
   "publishConfig": {
     "access": "public"
   },

src/AppVersion.idr

@@ -4,7 +4,7 @@ module AppVersion
 
 export
 appVersion : String
-appVersion = "1.2.0"
+appVersion = "1.3.0"
 
 export
 printVersion : HasIO io => io ()

src/BashCompletion.idr

@@ -48,6 +48,12 @@ cmdOpts partialArg "contribute" =
   if partialArg `isPrefixOf` "--checkout"
      then Just ["--checkout"]
      else Just []
+cmdOpts "--" "graph" = Nothing
+cmdOpts "-" "graph"  = Just ["--completed", "-c"]
+cmdOpts partialArg "graph" =
+  if partialArg `isPrefixOf` "--completed"
+     then Just ["--completed"]
+     else Nothing
 
 -- anything else requires configuration being loaded
 cmdOpts _ _ = Nothing

src/Data/PullRequest.idr

@@ -10,18 +10,30 @@ import Language.JSON.Accessors
 
 %default total
 
+namespace FFI
+  public export
+  data GitHubPRState = Open | Closed
+
 public export
-data PRState = Open | Closed
+data PRState = Open | Closed | Merged
 
 export
 Show PRState where
   show Open   = "open"
   show Closed = "closed"
+  show Merged = "merged"
+
+export
+toGHState : PRState -> GitHubPRState
+toGHState Open   = Open
+toGHState Closed = Closed
+toGHState Merged = Closed
 
 export
 Eq PRState where
   Open   == Open   = True
   Closed == Closed = True
+  Merged == Merged = True
   _ == _ = False
 
 public export
@@ -58,10 +70,12 @@ export
 isRequestedReviewer : String -> PullRequest -> Bool
 isRequestedReviewer login = any (== login) . reviewers
 
-parseState : String -> Either String PRState
-parseState "open"   = Right Open
-parseState "closed" = Right Closed
-parseState str      = Left "Failed to parse a Pull Request State (open/closed). Found \{str}."
+parseState : (merged : Bool) -> String -> Either String PRState
+parseState False "open" = Right Open
+parseState True  "open" = Left "Found a PR to be merged & open; this is a contradiction so something is wrong."
+parseState False "closed" = Right Closed
+parseState True  "closed" = Right Merged
+parseState _ str = Left "Failed to parse a Pull Request State (open/closed). Found \{str}."
 
 parseDateTime : String -> Either String Date
 parseDateTime = maybeToEither "Failed to parse Date" . parseDateTimeString
@@ -70,10 +84,11 @@ export
 parsePR : JSON -> Either String PullRequest
 parsePR json =
  do pr <- object json
-    [pullNumber, authorLogin, stateStr, createdAtStr, reviewerList, head] <- lookupAll ["pull_number", "author", "state", "created_at", "reviewers", "head_ref"] pr
+    [pullNumber, authorLogin, stateStr, createdAtStr, mergedStr, reviewerList, head] <- lookupAll ["pull_number", "author", "state", "created_at", "merged", "reviewers", "head_ref"] pr
     number    <- integer pullNumber
     author    <- string authorLogin
-    state     <- parseState    =<< string stateStr
+    merged    <- bool mergedStr
+    state     <- (parseState merged) =<< string stateStr
     createdAt <- parseDateTime =<< string createdAtStr
     reviewers <- array string reviewerList
     headRef   <- string head

src/FFI/GitHub.idr

@@ -68,7 +68,7 @@ listMyTeams : Octokit => Promise (List String)
 listMyTeams @{Kit ptr} =
   lines <$> (promiseIO $ prim__listMyTeams ptr)
 
-%foreign okit_ffi "list_prs"
+%foreign okit_ffi "list_pull_requests_for_branch"
 prim__listPRsForBranch : Ptr OctokitRef 
                       -> (owner : String) 
                       -> (repo : String) 
@@ -130,7 +130,11 @@ createComment : Octokit =>
 createComment @{Kit ptr} owner repo issueOrPrNumber message =
   ignore . promiseIO $ prim__createComment ptr owner repo issueOrPrNumber message
 
-pullRequestStateFilter : Maybe PRState -> String
+Show GitHubPRState where
+  show Open   = "open"
+  show Closed = "closed"
+
+pullRequestStateFilter : Maybe GitHubPRState -> String
 pullRequestStateFilter Nothing = "all"
 pullRequestStateFilter (Just s) = show s
 
@@ -149,7 +153,7 @@ export
 listPullReviewers : Octokit => 
                     (owner : String) 
                  -> (repo : String) 
-                 -> (stateFilter : Maybe PRState) 
+                 -> (stateFilter : Maybe GitHubPRState) 
                  -> (pageLimit : Fin 101) 
                  -> Promise (List String)
 listPullReviewers @{Kit ptr} owner repo stateFilter pageLimit = 
@@ -170,7 +174,7 @@ export
 listPullRequestsJsonStr : Octokit =>
                           (owner : String) 
                        -> (repo : String) 
-                       -> (stateFilter : Maybe PRState) 
+                       -> (stateFilter : Maybe GitHubPRState) 
                        -> (pageLimit : Fin 101) 
                        -> {default 0 page : Nat}
                        -> Promise String
@@ -191,7 +195,7 @@ export
 listPullRequests : Octokit => 
                    (owner : String) 
                 -> (repo : String) 
-                -> (stateFilter : Maybe PRState) 
+                -> (stateFilter : Maybe GitHubPRState) 
                 -> (pageLimit : Fin 101) 
                 -> {default 0 page : Nat}
                 -> Promise (List PullRequest)

src/Graph.idr

@@ -2,68 +2,98 @@ module Graph
 
 import Data.List
 import Data.ReviewScore
+import Data.SortedMap
 
 import Text.PrettyPrint.Prettyprinter
 import Text.PrettyPrint.Prettyprinter.Render.Terminal
 import Text.PrettyPrint.Prettyprinter.Symbols
 
+%default total
+
+data AugmentedReviewScore : login -> Type where
+  Augmented : ReviewScore login -> (bonus : Nat) -> AugmentedReviewScore login
+
+||| Graph a single line (bar) of dots.
+||| @ indentation a number of leading spaces to product off to the left (uses Doc's @indent@)
+||| @ score the net score to graph out in yellow.
+||| @ detractor the amount detracting from the score, graphed in red.
+||| @ bonus a bonus indicator graphed on the far right in green.
+bar : (indentation : Nat) -> (score : Nat) -> (detractor : Nat) -> (bonus : Nat) -> Doc AnsiStyle
+bar idt score detractor bonus = indent (cast idt) . hcat $
+                              [ annotate (color Red) . hcat $ replicate detractor (pretty '◦')
+                              , annotate (color Yellow) . hcat $ replicate score (pretty '·')
+                              , annotate (color Green) . hcat $ replicate bonus (pretty '▪')
+                              ]
+
+graphOne : Pretty login => (highScore : Nat) -> (AugmentedReviewScore login) -> Doc AnsiStyle
+graphOne highScore (Augmented (MkScore user partialScore combinedScore) bonus) =
+  let idt    = highScore `minus` (partialScore + bonus)
+      user   = annotate italic $ pretty user
+      detractor = (partialScore `minus` combinedScore)
+      remainingSpace = highScore `minus` combinedScore
+      -- we create a bar with the combinedScore and then fill in any
+      -- remaining space with an indication of the detractor. We cap
+      -- the detractor representation at the high score to make everything
+      -- line up nicely. The detractor is just there to give some indication
+      -- of review requests that did not count positively toward the score.
+  in  bar idt combinedScore (min remainingSpace detractor) bonus <++> user
+
+graph : Pretty login => (highScore : Nat) -> List (AugmentedReviewScore login) -> Doc AnsiStyle
+graph highScore = vsep . map (graphOne highScore)
+
 ||| Produce a graph of relative review workload for all developers matching the given
 ||| filter.
-||| @ closedReviews The logins of each reviewer of each closed PR (duplicates intact).
-||| @ openReviews   The logins of each reviewer of each open PR (duplicates intact).
-||| @ candidates    The logins of all potential reviewers that should be considered.
+||| @ closedReviews    The logins of each reviewer of each closed PR (duplicates intact).
+||| @ openReviews      The logins of each reviewer of each open PR (duplicates intact).
+||| @ candidates       The logins of all potential reviewers that should be considered.
+||| @ completedReviews Optionally pass a map from login to count of completed reviews to
+|||                    graph as well.
 export
 reviewsGraph : Ord login => Pretty login =>
                (closedReviews : List login)
             -> (openReviews : List login)
             -> (candidates : List login)
+            -> (completedReviews : Maybe (SortedMap login Nat))
             -> Doc AnsiStyle
-reviewsGraph closedReviews openReviews candidates =
+reviewsGraph closedReviews openReviews candidates completedReviews =
   let scoredOptions = reverse $ scoredReviewers closedReviews openReviews (sort $ nub candidates)
+      augmentedOptions : List (AugmentedReviewScore login) = 
+        case completedReviews of
+             Nothing        => (flip Augmented 0) <$> scoredOptions
+             Just completed => augment completed <$> scoredOptions
+      maxBonus = maybe 0 id (maxValue . SortedMap.toList <$> completedReviews)
   in  case scoredOptions of
            [] => emptyDoc
            ((MkScore _ s c) :: _) =>
-             let highScore = c + (s `minus` c)
-             in  header <+> graph (if highScore > 0 then highScore else 1) scoredOptions <+> line
+             let highScore = c + (s `minus` c) + maxBonus
+             in  header <+> graph (if highScore > 0 then highScore else 1) augmentedOptions <+> line
   where
     yellowDot : Doc AnsiStyle
     yellowDot = annotate (color Yellow) "·"
 
     redDot : Doc AnsiStyle
     redDot = annotate (color Red) "◦"
 
-    header : Doc AnsiStyle
-    header = vsep [ emptyDoc
-                  , pretty "Weighted review workload."
-                  , pretty "4x the number of open review requests" <++> parens yellowDot
-                  , pretty "1x the number of closed PRs with unanswered review requests" <++> parens redDot
-                  , parens $ redDot <++> pretty "overlayed on" <++> yellowDot
-                  , emptyDoc
-                  , emptyDoc
-                  ]
+    greenBox : Doc AnsiStyle
+    greenBox = annotate (color Green) "▪"
 
-    -- The "detractor" is an indication of the amount of the score that was taken
-    -- away by the heuristic in `scoredReviewers` that weights closed reviews with
-    -- unanswered review requests negatively.
-    bar : (indentation : Nat) -> (score : Nat) -> (detractor : Nat) -> Doc AnsiStyle
-    bar idt score detractor = indent (cast idt) . hcat $
-                                [ annotate (color Red) . pretty $ replicate detractor '◦'
-                                , annotate (color Yellow) . pretty $ replicate score '·'
-                                ]
+    header : Doc AnsiStyle
+    header = vsep $
+               catMaybes [ Just $ emptyDoc
+                         , Just $ pretty "Weighted review workload."
+                         , Just $ pretty "4x the number of open review requests" <++> parens yellowDot
+                         , Just $ pretty "1x the number of closed PRs with unanswered review requests" <++> parens redDot
+                         , if (null completedReviews) then Nothing else Just $ pretty "1x the number of completed reviews" <++> parens greenBox
+                         , Just $ parens $ redDot <++> pretty "overlayed on" <++> yellowDot
+                         , Just $ emptyDoc
+                         , Just $ emptyDoc
+                         ]
 
-    graphOne : (highScore : Nat) -> (ReviewScore login) -> Doc AnsiStyle
-    graphOne highScore (MkScore user partialScore combinedScore) =
-      let idt    = highScore `minus` partialScore
-          user   = annotate italic $ pretty user
-          detractor = (partialScore `minus` combinedScore)
-          remainingSpace = highScore `minus` combinedScore
-          -- we create a bar with the combinedScore and then fill in any
-          -- remaining space with an indication of the detractor. We cap
-          -- the detractor representation at the high score to make everything
-          -- line up nicely. The detractor is just there to give some indication
-          -- of review requests that did not count positively toward the score.
-      in  bar idt combinedScore (min remainingSpace detractor) <++> user
+    augment : (completedReviews : SortedMap login Nat) -> ReviewScore login -> AugmentedReviewScore login
+    augment completed score =
+      Augmented score (maybe 0 id $ lookup score.user completed)
 
-    graph : (highScore : Nat) -> List (ReviewScore login) -> Doc AnsiStyle
-    graph highScore = vsep . map (graphOne highScore)
+    maxValue : List (a, Nat) -> Nat
+    maxValue [] = 0
+    maxValue ((x, y) :: xs) = max y (maxValue xs)
 

src/Help.idr

@@ -38,7 +38,7 @@ harmony \{subcommand "<subcommand>"}
    - Reflect on the current state of ones own PRs and review requests.
   \{subcommand "list"} {\{argument "<team-slug>"}}
    - List the members of the given GitHub Team.
-  \{subcommand "graph"} {\{argument "<team-slug>"}}
+  \{subcommand "graph"} [\{argument "-c/--completed"}] {\{argument "<team-slug>"}}
    - Graph the relative review workload of the members of the given GitHub Team.
   \{subcommand "assign"} {\{argument "<team-slug>"} | \{argument "+<user-login>"}} [...]
    - Assign the given team(s) and one lucky member from one of those teams