GitHub branches

app/Main.hs

@@ -11,6 +11,7 @@ import qualified Brick.Widgets.List as L
 import Control.Concurrent.QSem
 import Control.Concurrent.STM (retry)
 import Control.Monad
+import Control.Monad.Logger (LogLevel(..))
 import Data.Function
 import Data.String.Interpolate
 import qualified Data.Text.IO as T
@@ -135,6 +136,8 @@ main = do
           , _appColorMode = V.FullColor
 
           , _appLogs = mempty
+
+          , _appLogLevelFilter = LevelInfo
         }
 
 

app/Sauron/Actions.hs

@@ -49,6 +49,23 @@ refresh bc item@(PaginatedWorkflowsNode _) (findRepoParent -> Just (RepoNode (En
   liftIO $ void $ async $ liftIO $ runReaderT (fetchWorkflows owner name item) bc
 refresh bc item@(PaginatedBranchesNode _) (findRepoParent -> Just (RepoNode (EntityData {_static=(owner, name)}))) =
   liftIO $ void $ async $ liftIO $ runReaderT (fetchBranches owner name item) bc
+refresh bc item@(OverallBranchesNode _) (findRepoParent -> Just (RepoNode (EntityData {_static=(owner, name)}))) =
+  liftIO $ void $ async $ liftIO $ runReaderT (fetchOverallBranches owner name item) bc
+refresh bc item@(PaginatedYourBranchesNode _) (findRepoParent -> Just (RepoNode (EntityData {_static=(owner, name), _state}))) =
+  readTVarIO _state >>= \case
+    Fetched (Repo {..}) -> liftIO $ void $ async $ liftIO $ runReaderT (fetchYourBranches owner name repoDefaultBranch item) bc
+    Fetching (Just (Repo {..})) -> liftIO $ void $ async $ liftIO $ runReaderT (fetchYourBranches owner name repoDefaultBranch item) bc
+    _ -> return ()
+refresh bc item@(PaginatedActiveBranchesNode _) (findRepoParent -> Just (RepoNode (EntityData {_static=(owner, name), _state}))) =
+  readTVarIO _state >>= \case
+    Fetched (Repo {..}) -> liftIO $ void $ async $ liftIO $ runReaderT (fetchActiveBranches owner name repoDefaultBranch item) bc
+    Fetching (Just (Repo {..})) -> liftIO $ void $ async $ liftIO $ runReaderT (fetchActiveBranches owner name repoDefaultBranch item) bc
+    _ -> return ()
+refresh bc item@(PaginatedStaleBranchesNode _) (findRepoParent -> Just (RepoNode (EntityData {_static=(owner, name), _state}))) =
+  readTVarIO _state >>= \case
+    Fetched (Repo {..}) -> liftIO $ void $ async $ liftIO $ runReaderT (fetchStaleBranches owner name repoDefaultBranch item) bc
+    Fetching (Just (Repo {..})) -> liftIO $ void $ async $ liftIO $ runReaderT (fetchStaleBranches owner name repoDefaultBranch item) bc
+    _ -> return ()
 refresh bc item@(PaginatedNotificationsNode _) _parents =
   liftIO $ void $ async $ liftIO $ runReaderT (fetchNotifications item) bc
 refresh bc item@(PaginatedReposNode (EntityData {})) _parents =
@@ -71,6 +88,8 @@ refresh bc item@(SingleJobNode (EntityData {_state})) parents@(findRepoParent ->
     liftIO $ void $ startJobHealthCheckIfNeeded bc item parents
 refresh bc item@(SingleBranchNode _) (findRepoParent -> Just (RepoNode (EntityData {_static=(owner, name)}))) =
   liftIO $ void $ async $ liftIO $ runReaderT (fetchBranchCommits owner name item) bc
+refresh bc item@(SingleBranchWithInfoNode _) (findRepoParent -> Just (RepoNode (EntityData {_static=(owner, name)}))) =
+  liftIO $ void $ async $ liftIO $ runReaderT (fetchBranchWithInfoCommits owner name item) bc
 refresh bc (SingleCommitNode (EntityData {_static=commit, _state})) (findRepoParent -> Just (RepoNode (EntityData {_static=(owner, name)}))) =
   liftIO $ void $ async $ liftIO $ runReaderT (fetchCommitDetails owner name (commitSha commit) _state) bc
 refresh _ (SingleNotificationNode _) _ = return ()

app/Sauron/Actions/Util.hs

@@ -24,11 +24,13 @@ import Control.Monad.IO.Class
 import Control.Monad.Logger (LogLevel(..))
 import Control.Monad.Reader
 import Data.Aeson (FromJSON)
+import qualified Data.ByteString as BS
 import qualified Data.List as L
 import qualified Data.Text as T
 import Data.Time
 import GitHub
 import Network.HTTP.Client (Response, responseBody, responseHeaders)
+import Network.HTTP.Types (EscapeItem(..))
 import Network.HTTP.Types.Header (hContentLength)
 import Relude
 import Sauron.Types
@@ -66,13 +68,29 @@ findRepoParent elems = viaNonEmpty head [x | SomeNode x@(RepoNode _) <- toList e
 
 requestToUrl :: Request k a -> Text
 requestToUrl req = case req of
-  Query paths _queryString -> pathsToUrl paths
-  PagedQuery paths _queryString _fetchCount -> pathsToUrl paths
+  Query paths queryString -> pathsToUrl paths <> formatQueryString queryString
+  PagedQuery paths queryString _fetchCount -> pathsToUrl paths <> formatQueryString queryString
   Command _method paths _body -> pathsToUrl paths
   where
     pathsToUrl :: [Text] -> Text
     pathsToUrl = ("/" <>) . T.intercalate "/"
 
+    formatQueryString :: QueryString -> Text
+    formatQueryString queryParams =
+      if null queryParams
+        then ""
+        else "?" <> T.intercalate "&" (map formatParam queryParams)
+
+    formatParam :: (BS.ByteString, [EscapeItem]) -> Text
+    formatParam (key, values) = keyText <> "=" <> valuesText
+      where
+        keyText = decodeUtf8 key
+        valuesText = T.intercalate "," $ map formatEscapeItem values
+
+    formatEscapeItem :: EscapeItem -> Text
+    formatEscapeItem (QE s) = decodeUtf8 s -- QE is already query-escaped
+    formatEscapeItem (QN s) = decodeUtf8 s
+
 githubWithLogging :: (MonadReader BaseContext m, MonadIO m, FromJSON a) => Request k a -> m (Either Error a)
 githubWithLogging request = fmap responseBody <$> githubWithLoggingResponse request
 
@@ -84,23 +102,26 @@ githubWithLogging' bc request = fmap responseBody <$> githubWithLogging'' bc req
 
 githubWithLogging'' :: (MonadIO m, FromJSON a) => BaseContext -> Request k a -> m (Either Error (Response a))
 githubWithLogging'' (BaseContext {..}) request = do
+  startTime <- liftIO getCurrentTime
   result <- liftIO $ executeRequestWithMgrAndRes manager auth request
-  logResult eventChan request result
+  endTime <- liftIO getCurrentTime
+  let duration = diffUTCTime endTime startTime
+  logResult eventChan request result (Just duration)
   return result
 
-logResult :: (MonadIO m) => BChan AppEvent -> Request k a -> Either Error (Response b) -> m ()
-logResult eventChan request result = do
+logResult :: (MonadIO m) => BChan AppEvent -> Request k a -> Either Error (Response b) -> Maybe NominalDiffTime -> m ()
+logResult eventChan request result maybeDuration = do
   now <- liftIO getCurrentTime
   let url = requestToUrl request
   let level = case result of Left _ -> LevelError; _ -> LevelInfo
   let msg = case result of
         Left err -> "Failed: " <> url <> " - " <> show err
         Right response ->
           let sizeInfo = case getResponseSize response of
-                Nothing -> " " <> show (responseHeaders response)
+                Nothing -> "" -- " " <> show (responseHeaders response)
                 Just size -> " (" <> show size <> " bytes)"
           in (url <> sizeInfo)
-  let logEntry = LogEntry now level msg
+  let logEntry = LogEntry now level msg maybeDuration
   liftIO $ writeBChan eventChan (LogEntryAdded logEntry)
   where
     getResponseSize :: Response a -> Maybe Int

app/Sauron/Event.hs

@@ -9,6 +9,7 @@ import Brick.Forms
 import Brick.Widgets.Edit (handleEditorEvent)
 import Brick.Widgets.List
 import Control.Monad
+import Control.Monad.Logger (LogLevel(..))
 import Control.Monad.IO.Unlift
 import Data.Function
 import qualified Data.Sequence as Seq
@@ -46,6 +47,7 @@ appEvent _s (AppEvent (LogEntryAdded logEntry)) = do
   modify (appLogs %~ (Seq.|> logEntry))
 
 
+
 -- Handle modal events
 appEvent s@(_appModal -> Just modalState) e = case e of
   VtyEvent ev -> case modalState of
@@ -86,10 +88,28 @@ appEvent s@(_appModal -> Just modalState) e = case e of
       (V.EvKey (V.KChar 'q') [V.MCtrl]) -> do
         modify (appModal .~ Nothing)
         liftIO $ atomically $ writeTVar (_appModalVariable s) Nothing
+      (V.EvKey (V.KChar 'c') []) -> do
+        modify (appLogs .~ Seq.empty)
       (V.EvKey (V.KChar 'v') [V.MCtrl]) -> vScrollPage (viewportScroll LogModalContent) Down
       (V.EvKey (V.KChar 'v') [V.MMeta]) -> vScrollPage (viewportScroll LogModalContent) Up
       (V.EvKey (V.KChar 'n') [V.MCtrl]) -> vScrollBy (viewportScroll LogModalContent) 1
       (V.EvKey (V.KChar 'p') [V.MCtrl]) -> vScrollBy (viewportScroll LogModalContent) (-1)
+      (V.EvKey V.KUp []) -> vScrollBy (viewportScroll LogModalContent) (-1)
+      (V.EvKey V.KDown []) -> vScrollBy (viewportScroll LogModalContent) 1
+      (V.EvKey V.KPageUp []) -> vScrollPage (viewportScroll LogModalContent) Up
+      (V.EvKey V.KPageDown []) -> vScrollPage (viewportScroll LogModalContent) Down
+      (V.EvKey (V.KChar 'd') []) -> do
+        modify (appLogLevelFilter .~ LevelDebug)
+        vScrollToEnd (viewportScroll LogModalContent)
+      (V.EvKey (V.KChar 'i') []) -> do
+        modify (appLogLevelFilter .~ LevelInfo)
+        vScrollToEnd (viewportScroll LogModalContent)
+      (V.EvKey (V.KChar 'w') []) -> do
+        modify (appLogLevelFilter .~ LevelWarn)
+        vScrollToEnd (viewportScroll LogModalContent)
+      (V.EvKey (V.KChar 'e') []) -> do
+        modify (appLogLevelFilter .~ LevelError)
+        vScrollToEnd (viewportScroll LogModalContent)
       _ -> return () -- No other interactions for LogModal
   _ -> return ()
 
@@ -177,8 +197,10 @@ appEvent s (VtyEvent e) = case e of
       liftIO $ atomically $ writeTVar (_appModalVariable s) (Just (ZoomModalState (SomeNode variableEl)))
 
   V.EvKey (V.KChar 'l') [V.MCtrl] -> do
-    modify (appModal .~ Just LogModalState)
+    modify (appModal ?~ LogModalState)
     liftIO $ atomically $ writeTVar (_appModalVariable s) (Just LogModalState)
+    -- Scroll to the bottom of the log modal content to show latest logs
+    vScrollToEnd (viewportScroll LogModalContent)
 
   V.EvKey c [] | c `elem` [V.KEsc, exitKey] -> do
     -- Cancel everything and wait for cleanups
@@ -194,7 +216,7 @@ appEvent _s (MouseDown (ListRow _i) V.BScrollUp _ _) = do
 appEvent _s (MouseDown (ListRow _i) V.BScrollDown _ _) = do
   vScrollBy (viewportScroll MainList) 1
 appEvent _s (MouseDown (ListRow n) V.BLeft _ _) = do
-  modify (appMainList %~ (listMoveTo n))
+  modify (appMainList %~ listMoveTo n)
 
 appEvent _ _ = return ()
 

app/Sauron/Event/Helpers.hs

@@ -67,6 +67,9 @@ getPaginationInfo (SomeNode (PaginatedPullsNode (EntityData {..}))) = Just _page
 getPaginationInfo (SomeNode (PaginatedWorkflowsNode (EntityData {..}))) = Just _pageInfo
 getPaginationInfo (SomeNode (PaginatedReposNode (EntityData {..}))) = Just _pageInfo
 getPaginationInfo (SomeNode (PaginatedBranchesNode (EntityData {..}))) = Just _pageInfo
+getPaginationInfo (SomeNode (PaginatedYourBranchesNode (EntityData {..}))) = Just _pageInfo
+getPaginationInfo (SomeNode (PaginatedActiveBranchesNode (EntityData {..}))) = Just _pageInfo
+getPaginationInfo (SomeNode (PaginatedStaleBranchesNode (EntityData {..}))) = Just _pageInfo
 getPaginationInfo (SomeNode (PaginatedNotificationsNode (EntityData {..}))) = Just _pageInfo
 getPaginationInfo _ = Nothing
 

app/Sauron/Event/Open.hs

@@ -33,12 +33,17 @@ getNodeUrl (PaginatedIssuesNode _) (findRepoBaseUrl -> Just repoBaseUrl) = Just
 getNodeUrl (PaginatedPullsNode _) (findRepoBaseUrl -> Just repoBaseUrl) = Just (repoBaseUrl <> "/pulls")
 getNodeUrl (PaginatedWorkflowsNode _) (findRepoBaseUrl -> Just repoBaseUrl) = Just (repoBaseUrl <> "/actions")
 getNodeUrl (PaginatedBranchesNode _) (findRepoBaseUrl -> Just repoBaseUrl) = Just (repoBaseUrl <> "/branches")
+getNodeUrl (OverallBranchesNode _) (findRepoBaseUrl -> Just repoBaseUrl) = Just (repoBaseUrl <> "/branches")
+getNodeUrl (PaginatedYourBranchesNode _) (findRepoBaseUrl -> Just repoBaseUrl) = Just (repoBaseUrl <> "/branches/yours")
+getNodeUrl (PaginatedActiveBranchesNode _) (findRepoBaseUrl -> Just repoBaseUrl) = Just (repoBaseUrl <> "/branches/active")
+getNodeUrl (PaginatedStaleBranchesNode _) (findRepoBaseUrl -> Just repoBaseUrl) = Just (repoBaseUrl <> "/branches/stale")
 getNodeUrl (PaginatedNotificationsNode _) _ = Just "https://github.com/notifications"
 getNodeUrl (SingleIssueNode (EntityData {_static=(Issue {issueHtmlUrl=(Just url)})})) _parents = Just (toString $ getUrl url)
 getNodeUrl (SinglePullNode (EntityData {_static=(Issue {issueHtmlUrl=(Just url)})})) _parents = Just (toString $ getUrl url)
 getNodeUrl (SingleWorkflowNode (EntityData {_static=workflowRun})) _ = Just (toString $ getUrl $ workflowRunHtmlUrl workflowRun)
 getNodeUrl (SingleJobNode (EntityData {_state=(fetchableCurrent -> Just (job, _))})) _ = Just (toString $ getUrl $ jobHtmlUrl job)
 getNodeUrl (SingleBranchNode (EntityData {_static=branch})) (findRepoBaseUrl -> Just repoBaseUrl) = Just (repoBaseUrl <> "/tree/" <> toString (branchName branch))
+getNodeUrl (SingleBranchWithInfoNode (EntityData {_static=(branchInfo, _columnWidths)})) (findRepoBaseUrl -> Just repoBaseUrl) = Just (repoBaseUrl <> "/tree/" <> toString (branchWithInfoBranchName branchInfo))
 getNodeUrl (SingleCommitNode (EntityData {_static=commit})) (findRepoBaseUrl -> Just repoBaseUrl) = Just (repoBaseUrl <> "/commit/" <> toString (untagName (commitSha commit)))
 getNodeUrl (RepoNode _) (findRepoBaseUrl -> Just repoBaseUrl) = Just repoBaseUrl
 getNodeUrl _ _ = Nothing

app/Sauron/Expanding.hs

@@ -25,12 +25,17 @@ getExpandedList = V.fromList . concatMap expandNodes . V.toList
           PaginatedWorkflowsNode (EntityData {..}) -> expandTyped _children
           PaginatedReposNode (EntityData {..}) -> expandTyped _children
           PaginatedBranchesNode (EntityData {..}) -> expandTyped _children
+          OverallBranchesNode (EntityData {..}) -> expandWrapped _children
+          PaginatedYourBranchesNode (EntityData {..}) -> expandTyped _children
+          PaginatedActiveBranchesNode (EntityData {..}) -> expandTyped _children
+          PaginatedStaleBranchesNode (EntityData {..}) -> expandTyped _children
           PaginatedNotificationsNode (EntityData {..}) -> expandTyped _children
           SingleIssueNode (EntityData {..}) -> expandChildless _children
           SinglePullNode (EntityData {..}) -> expandChildless _children
           SingleWorkflowNode (EntityData {..}) -> expandTyped _children
           SingleJobNode (EntityData {..}) -> expandTyped _children
           SingleBranchNode (EntityData {..}) -> expandTyped _children
+          SingleBranchWithInfoNode (EntityData {..}) -> expandTyped _children
           SingleCommitNode (EntityData {..}) -> expandChildless _children
           SingleNotificationNode (EntityData {..}) -> expandChildless _children
           JobLogGroupNode (EntityData {..}) -> expandTyped _children