Merge pull request #55 from mattpolzin/whoami-improvements

Whoami improvements

harmony.ipkg

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

package.json

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

src/AppVersion.idr

@@ -2,7 +2,7 @@ module AppVersion
 
 export
 appVersion : String
-appVersion = "0.7.0"
+appVersion = "0.7.1"
 
 export
 printVersion : HasIO io => io ()

src/Main.idr

@@ -24,6 +24,7 @@ import System.File
 import Text.PrettyPrint.Prettyprinter
 import Text.PrettyPrint.Prettyprinter.Render.Terminal
 import User
+import Util
 
 %default total
 
@@ -77,7 +78,7 @@ listTeam @{config} team =
   do teamMemberLogins <- sort <$> listTeamMembers config.org team
      teamMembersJson <- promiseAll =<< traverse forkedUser teamMemberLogins
      teamMembers <- traverse (either . parseUser) teamMembersJson
-     liftIO . putDoc . vsep $ putNameLn <$> teamMembers
+     renderIO . vsep $ putNameLn <$> teamMembers
   where
     forkedUser : (login : String) -> Promise Future
     forkedUser = fork . ("user --json " ++)
@@ -92,10 +93,7 @@ graphTeam : Config => Octokit =>
 graphTeam @{config} team =
   do teamMemberLogins <- listTeamMembers config.org team
      (openReviewers, closedReviewers) <- listReviewers 100 {pageBreaks=4}
-     liftIO . putDoc . maybeDecorated $ reviewsGraph closedReviewers openReviewers teamMemberLogins
-  where
-    maybeDecorated : Doc AnsiStyle -> Doc AnsiStyle
-    maybeDecorated = if config.colors then id else unAnnotate
+     renderIO $ reviewsGraph closedReviewers openReviewers teamMemberLogins
 
 data ContributeArg = Checkout | Skip Nat
 

src/PullRequest.idr

@@ -144,22 +144,17 @@ requestReviewers @{config} pr teamNames forcedReviewers {dry} =
             whenJust chosenUser $ \cu =>
               createComment config.org config.repo pr.number (prComment cu)
      if null users
-       then putStrLn . maybeDecorate $ vsep [
+       then putStrLn . renderString $ vsep [
                        annotate (color Yellow) $ pretty "Could not pick a user from the given Team "
                      , pretty "(perhaps the only option was the author of the pull request?)."
                      ]
-       else putStrLn . maybeDecorate $ vsep [
+       else putStrLn . renderString $ vsep [
                        pretty "Assigned \{userNotice chosenUser}\{teamNotice teams} to the open PR "
                      , pretty "for the current branch (\{pr.webURI})."
                      ]
   where
-    maybeDecorate : Doc AnsiStyle -> String
-    maybeDecorate doc =
-      let render = if config.colors then id else unAnnotate
-      in  renderString . layoutPretty defaultLayoutOptions $ render doc
-
     csv : List String -> String
-    csv = maybeDecorate . encloseSep emptyDoc emptyDoc (pretty ", ") . map (annotate (color Green) . pretty)
+    csv = renderString . encloseSep emptyDoc emptyDoc (pretty ", ") . map (annotate (color Green) . pretty)
 
     userNotice : (chosenReviewer : Maybe String) -> String
     userNotice Nothing       = case forcedReviewers of

src/User.idr

@@ -107,6 +107,9 @@ namespace Reflect
               , emptyDoc
               ]
 
+  ||| Print information about the currently authenticated user's recent Pull Request
+  ||| history. What review requests they have addressed or not, how many PRs they 
+  ||| have waiting for review, how many have been closed recently, etc.
   export
   reflectOnSelf : Config => Octokit =>
                   Promise ()
@@ -124,7 +127,7 @@ namespace Reflect
       mapHom (head' . sort . map createdAt) (openAuthored, openRequested)
     -- TODO: get Terminal width from somewhere to set the page width
     --       to the min of the Terminal width or the intro length.
-    putStrLn . renderString $
+    renderIO $
       print (length intro)
             (length reviews)
             (length openRequested)
@@ -136,22 +139,59 @@ namespace Reflect
             earliestOpenReq
 
 namespace Me
+  print : (gitEmail : Maybe String)
+       -> (githubUser : User)
+       -> (githubTeams : List String)
+       -> Doc AnsiStyle
+  print gitEmail githubUser githubTeams =
+    vsep [
+        emptyDoc
+      , email
+      , emptyDoc
+      , fullName
+      , login
+      , emptyDoc
+      , teams
+      , emptyDoc
+      ]
+    where
+      ul : String -> Doc AnsiStyle
+      ul = annotate underline . pretty
+
+      it : String -> Doc AnsiStyle
+      it = annotate italic . pretty
+
+      green : String -> Doc AnsiStyle
+      green = annotate (color Green) . pretty
+
+      email : Doc AnsiStyle
+      email = "Git Email:" <++> case gitEmail of
+                                     Just e => green e
+                                     Nothing => it "Not set"
+
+      fullName : Doc AnsiStyle
+      fullName = "GitHub Name:" <++> green githubUser.name
+
+      login : Doc AnsiStyle
+      login = "GitHub Login:" <++> green githubUser.login
+
+      teams : Doc AnsiStyle
+      teams = vsep $
+                ul "GitHub Teams:" :: (map it githubTeams)
+
+
+  ||| Print information about the currently authenticated and configured user.
+  ||| This includes information that can be retrieved from Git as well as GitHub.
   export
   printInfoOnSelf : Config => Octokit => Git =>
                     Promise ()
   printInfoOnSelf = do
     gitEmail <- handleUnsetEmail <$> userEmail
     githubUser <- getSelf
     githubTeams <- sort <$> listMyTeams
-    putStrLn "Git Email: \{gitEmail}"
-    putStrLn ""
-    putStrLn "GitHub Name: \{githubUser.name}"
-    putStrLn "GitHub Login: \{githubUser.login}"
-    putStrLn ""
-    putStrLn "GitHub Teams:"
-    traverse_ putStrLn githubTeams
+    renderIO $ print gitEmail githubUser githubTeams
       where
-        handleUnsetEmail : String -> String
-        handleUnsetEmail "" = "Not set"
-        handleUnsetEmail e = e
+        handleUnsetEmail : String -> Maybe String
+        handleUnsetEmail "" = Nothing
+        handleUnsetEmail e = Just e
 

src/Util.idr

@@ -15,6 +15,14 @@ renderString : Config => Doc AnsiStyle -> String
 renderString @{config} =
   renderString . layoutPretty defaultLayoutOptions . if config.colors then id else unAnnotate
 
+||| Render with or without color based on configuration
+export
+renderIO : Config => HasIO io => Doc AnsiStyle -> io ()
+renderIO @{config} =
+  liftIO . putDoc . if config.colors then id else unAnnotate
+
+||| Get lines from stdin until either the Fuel runs out or
+||| two empty lines are encountered.
 export
 getManyLines : HasIO io => Fuel -> io (List String)
 getManyLines = getMoreLines []
@@ -28,6 +36,10 @@ getManyLines = getMoreLines []
               ("" :: rest, "") => pure (reverse rest)
               _                => getMoreLines (line :: acc) fuel
 
+||| If possible, extract a Jira ticket reference from the given string.
+|||
+||| For example, in "PRJ-123 do a thing" `parseJiraPrefix` will give you
+||| "PRJ-123"
 export
 parseJiraPrefix : String -> Maybe String
 parseJiraPrefix = map (pack . reverse) . guardSuccess . foldl go startOver . unpack