State consolidation

app/Main.hs

@@ -29,7 +29,7 @@ import Sauron.Actions.Util (githubWithLogging', withGithubApiSemaphore')
 import Sauron.Auth
 import Sauron.Event
 import Sauron.Expanding
-import Sauron.Fetch.Core (makeEmptyElem)
+import Sauron.Fetch.Core (makeEmptyElemWithState)
 import Sauron.Fix
 import Sauron.OAuth (authenticateWithGitHub, loadSavedToken)
 import Sauron.Options
@@ -106,25 +106,27 @@ main = do
   CliArgs {cliConfigFile, cliShowAllRepos, cliColorMode, cliSplitLogs} <- parseCliArgs
 
   eventChan <- newBChan 10
-  baseContext@(BaseContext {requestSemaphore}) <- buildBaseContext eventChan
+  baseContext'@(BaseContext {requestSemaphore}) <- buildBaseContext eventChan
 
-  currentUser@(User {userLogin}) <- withGithubApiSemaphore' requestSemaphore (githubWithLogging' baseContext userInfoCurrentR) >>= \case
+  currentUser@(User {userLogin}) <- withGithubApiSemaphore' requestSemaphore (githubWithLogging' baseContext' userInfoCurrentR) >>= \case
     Left err -> throwIO $ userError [i|Failed to fetch currently authenticated user: #{err}|]
     Right x -> pure x
 
+  let baseContext = baseContext' { currentUser = Just currentUser }
+
   listElems' :: V.Vector (SomeNode Variable) <- case cliShowAllRepos of
     True -> V.singleton . SomeNode <$> allReposForUser baseContext defaultHealthCheckPeriodUs userLogin
     False -> case cliConfigFile of
       Just configFile -> reposFromConfigFile baseContext defaultHealthCheckPeriodUs configFile
       Nothing -> isContainedInGitRepo >>= \case
-        Just (namespace, name) -> (fmap SomeNode) <$> reposFromCurrentDirectory baseContext defaultHealthCheckPeriodUs (namespace, name)
+        Just (namespace, name) -> fmap SomeNode <$> reposFromCurrentDirectory baseContext defaultHealthCheckPeriodUs (namespace, name)
         Nothing -> V.singleton . SomeNode <$> allReposForUser baseContext defaultHealthCheckPeriodUs userLogin
 
   -- Prepend a PaginatedNotificationsNode
-  listElems <- flip V.cons listElems' <$> atomically (SomeNode . PaginatedNotificationsNode <$> makeEmptyElem baseContext () "" 0)
+  listElems <- flip V.cons listElems' <$> atomically (SomeNode . PaginatedNotificationsNode <$> makeEmptyElemWithState baseContext () (SearchNone, emptyPageInfo, NotFetched) "" 0)
 
   -- Kick off initial fetches
-  runReaderT (refreshAll listElems) baseContext
+  runReaderT (refreshVisibleLines listElems) baseContext
 
   listElemsFixed :: V.Vector (SomeNode Fixed) <- atomically $ mapM fixSomeNode listElems
 
@@ -267,4 +269,5 @@ buildBaseContext eventChan = do
     , getIdentifier = getIdentifier
     , getIdentifierSTM = getIdentifierSTM
     , eventChan = eventChan
+    , currentUser = Nothing
     }

app/Sauron/Event/Helpers.hs

@@ -35,12 +35,12 @@ withFixedElemAndParents s cb =
 
 withNthChildAndPaginationParent :: (
   MonadIO m
-  ) => AppState -> (SomeNode Fixed -> SomeNode Variable -> (SomeNode Variable, TVar PageInfo) -> NonEmpty (SomeNode Variable) -> m ()) -> m ()
+  ) => AppState -> (SomeNode Fixed -> SomeNode Variable -> (SomeNode Variable, STM PageInfo, PageInfo -> STM ()) -> NonEmpty (SomeNode Variable) -> m ()) -> m ()
 withNthChildAndPaginationParent s cb =
   withFixedElemAndParents s $ \fixedEl variableEl parents ->
     case L.dropWhile (not . isPaginationNode) (toList parents) of
-      (el@(getPaginationInfo -> Just pageInfo'):rest) ->
-        cb fixedEl variableEl (el, pageInfo') (el :| rest)
+      (el@(getPaginationInfo -> Just (readPageInfo, writePageInfo)):rest) ->
+        cb fixedEl variableEl (el, readPageInfo, writePageInfo) (el :| rest)
       _ -> return ()
 
 withNthChildAndRepoParent :: MonadIO m => AppState -> (SomeNode Fixed -> SomeNode Variable -> Node Variable RepoT -> m ()) -> m ()
@@ -61,18 +61,30 @@ withRepoParent s cb = do
 isPaginationNode :: SomeNode Variable -> Bool
 isPaginationNode = isJust . getPaginationInfo
 
-getPaginationInfo :: SomeNode Variable -> Maybe (TVar PageInfo)
-getPaginationInfo (SomeNode (PaginatedIssuesNode (EntityData {..}))) = Just _pageInfo
-getPaginationInfo (SomeNode (PaginatedPullsNode (EntityData {..}))) = Just _pageInfo
-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 :: SomeNode Variable -> Maybe (STM PageInfo, PageInfo -> STM ())
+getPaginationInfo (SomeNode (PaginatedIssuesNode (EntityData {_state}))) = Just (makePaginationActions _state)
+getPaginationInfo (SomeNode (PaginatedPullsNode (EntityData {_state}))) = Just (makePaginationActions _state)
+getPaginationInfo (SomeNode (PaginatedWorkflowsNode (EntityData {_state}))) = Just (makePaginationActions _state)
+getPaginationInfo (SomeNode (PaginatedReposNode (EntityData {_state}))) = Just (makePaginationActions _state)
+getPaginationInfo (SomeNode (PaginatedYourBranchesNode (EntityData {_state}))) = Just (makePaginationActions _state)
+getPaginationInfo (SomeNode (PaginatedActiveBranchesNode (EntityData {_state}))) = Just (makePaginationActions _state)
+getPaginationInfo (SomeNode (PaginatedStaleBranchesNode (EntityData {_state}))) = Just (makePaginationActions _state)
+getPaginationInfo (SomeNode (PaginatedNotificationsNode (EntityData {_state}))) = Just (makePaginationActions _state)
+getPaginationInfo (SomeNode (PaginatedBranchesNode (EntityData {_state}))) = Just (makePaginationActions _state)
 getPaginationInfo _ = Nothing
 
+makePaginationActions :: TVar (Search, PageInfo, Fetchable Int) -> (STM PageInfo, PageInfo -> STM ())
+makePaginationActions stateVar = (readPageInfo, writePageInfo)
+  where
+    readPageInfo = snd3 <$> readTVar stateVar
+
+    writePageInfo newPageInfo = do
+      (search, _, fetchable) <- readTVar stateVar
+      writeTVar stateVar (search, newPageInfo, fetchable)
+
+    snd3 :: (a, b, c) -> b
+    snd3 (_, b, _) = b
+
 -- * Computing nth child in the presence of expanding
 
 -- | Returns the node at the head of the list, and then its successive parents

app/Sauron/Event/Open.hs

@@ -5,35 +5,27 @@ module Sauron.Event.Open (
   openNode
   ) where
 
-import Control.Monad
 import Control.Monad.IO.Unlift
 import Data.Char (isDigit)
 import Data.Function
 import GitHub
 import Network.URI (parseURI, uriPath)
 import Relude hiding (Down, pi)
 import Sauron.Actions
+import Sauron.Logging
 import Sauron.Types
 
 
 openNode :: (MonadIO m) => BaseContext -> NonEmpty (SomeNode Variable) -> Node Fixed a -> m ()
-openNode _baseContext elems (JobLogGroupNode _) = case findParentJobNode (toList elems) of
-  Just (SingleJobNode (EntityData {_state})) -> do
-    jobState <- readTVarIO _state
-    case fetchableCurrent jobState of
-      Just job -> openBrowserToUrl (toString $ getUrl $ jobHtmlUrl job)
-      Nothing -> return ()
-  _ -> return ()
-openNode _baseContext elems el = case getNodeUrl el (toList elems) of
+openNode bc elems el = case getNodeUrl el (toList elems) of
   Just url -> openBrowserToUrl url
-  Nothing -> return ()
+  Nothing -> warn' bc [i|(#{el}) Couldn't find URL to open node|]
 
 getNodeUrl :: Node Fixed a -> [SomeNode Variable] -> Maybe String
 getNodeUrl (PaginatedIssuesNode _) (findRepoBaseUrl -> Just repoBaseUrl) = Just (repoBaseUrl <> "/issues")
 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")
@@ -42,7 +34,7 @@ getNodeUrl (SingleNotificationNode (EntityData {_static=notification})) _ = Just
 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 (SingleJobNode (EntityData {_static=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)))
@@ -55,11 +47,6 @@ findRepoBaseUrl (SomeNode (RepoNode (EntityData {_static=(owner, name)})) : _) =
   Just ("https://github.com/" <> toString (untagName owner) <> "/" <> toString (untagName name))
 findRepoBaseUrl (_ : rest) = findRepoBaseUrl rest
 
-findParentJobNode :: [SomeNode Variable] -> Maybe (Node Variable SingleJobT)
-findParentJobNode [] = Nothing
-findParentJobNode (SomeNode (SingleJobNode ed) : _) = Just (SingleJobNode ed)
-findParentJobNode (_ : rest) = findParentJobNode rest
-
 getNotificationUrl :: Notification -> String
 getNotificationUrl notification = case (subjectLatestCommentURL, subjectURL, subjectType) of
   -- If there's a latest comment URL, try to convert it to a web URL with anchor

app/Sauron/Event/Paging.hs

@@ -12,21 +12,24 @@ import Relude hiding (Down, pi)
 import Sauron.Actions
 import Sauron.Event.Helpers
 import Sauron.Types
-import UnliftIO.STM (stateTVar)
 
 
 tryNavigatePage :: AppState -> (PageInfo -> PageInfo) -> EventM ClickableName AppState ()
 tryNavigatePage s cb =
-  withNthChildAndPaginationParent s $ \_fixedEl _el (SomeNode paginationEl, pageInfo') parents -> do
-    didChange <- atomically $ stateTVar pageInfo' $ \pi ->
-      let pi' = cb pi in (pi' /= pi, pi')
+  withNthChildAndPaginationParent s $ \_fixedEl _el (SomeNode paginationEl, readPageInfo, writePageInfo) parents -> do
+    didChange <- liftIO $ atomically $ do
+      currentPageInfo <- readPageInfo
+      let newPageInfo = cb currentPageInfo
+      let hasChanged = newPageInfo /= currentPageInfo
+      when hasChanged $ writePageInfo newPageInfo
+      return hasChanged
     when didChange $ do
       -- Mark the pagination node selected
       expandedList <- gets (^. appMainList)
       forM_ (Vec.findIndex (\(SomeNode el) -> (_ident (getEntityData paginationEl) == _ident (getEntityData el))) (listElements expandedList)) $ \index ->
         modify (appMainList %~ listMoveTo index)
 
-      refresh (s ^. appBaseContext) paginationEl parents
+      void $ refreshLine (s ^. appBaseContext) paginationEl parents
 
 goNextPage :: PageInfo -> PageInfo
 goNextPage pi@(PageInfo {..}) = pi {

app/Sauron/Event/Search.hs

@@ -0,0 +1,44 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+
+module Sauron.Event.Search (
+  updateSearchForNode
+  , getCurrentSearch
+  , ensureNonEmptySearch
+) where
+
+import Lens.Micro
+import Relude
+import Sauron.Types
+
+
+updateSearchForNode :: Node Variable a -> Search -> STM ()
+updateSearchForNode (PaginatedIssuesNode (EntityData {_state})) search = modifyTVar' _state (set _1 search)
+updateSearchForNode (PaginatedPullsNode (EntityData {_state})) search = modifyTVar' _state (set _1 search)
+updateSearchForNode (PaginatedWorkflowsNode (EntityData {_state})) search = modifyTVar' _state (set _1 search)
+updateSearchForNode (PaginatedReposNode (EntityData {_state})) search = modifyTVar' _state (set _1 search)
+updateSearchForNode (PaginatedYourBranchesNode (EntityData {_state})) search = modifyTVar' _state (set _1 search)
+updateSearchForNode (PaginatedActiveBranchesNode (EntityData {_state})) search = modifyTVar' _state (set _1 search)
+updateSearchForNode (PaginatedStaleBranchesNode (EntityData {_state})) search = modifyTVar' _state (set _1 search)
+updateSearchForNode (PaginatedNotificationsNode (EntityData {_state})) search = modifyTVar' _state (set _1 search)
+updateSearchForNode (PaginatedBranchesNode (EntityData {_state})) search = modifyTVar' _state (set _1 search)
+updateSearchForNode _ _ = return () -- Non-searchable nodes do nothing
+
+getCurrentSearch :: Node Variable a -> STM Search
+getCurrentSearch (PaginatedIssuesNode (EntityData {_state})) = (^. _1) <$> readTVar _state
+getCurrentSearch (PaginatedPullsNode (EntityData {_state})) = (^. _1) <$> readTVar _state
+getCurrentSearch (PaginatedWorkflowsNode (EntityData {_state})) = (^. _1) <$> readTVar _state
+getCurrentSearch (PaginatedReposNode (EntityData {_state})) = (^. _1) <$> readTVar _state
+getCurrentSearch (PaginatedYourBranchesNode (EntityData {_state})) = (^. _1) <$> readTVar _state
+getCurrentSearch (PaginatedActiveBranchesNode (EntityData {_state})) = (^. _1) <$> readTVar _state
+getCurrentSearch (PaginatedStaleBranchesNode (EntityData {_state})) = (^. _1) <$> readTVar _state
+getCurrentSearch (PaginatedNotificationsNode (EntityData {_state})) = (^. _1) <$> readTVar _state
+getCurrentSearch (PaginatedBranchesNode (EntityData {_state})) = (^. _1) <$> readTVar _state
+getCurrentSearch _ = return SearchNone
+
+ensureNonEmptySearch :: Node Variable a -> STM Text
+ensureNonEmptySearch node = getCurrentSearch node >>= \case
+  SearchNone -> do
+    updateSearchForNode node (SearchText "")
+    return ""
+  SearchText t -> return t

app/Sauron/Event/Util.hs

@@ -0,0 +1,19 @@
+{-# LANGUAGE RankNTypes #-}
+
+module Sauron.Event.Util (
+  withScroll
+  ) where
+
+import Brick as B
+import Brick.Widgets.List
+import Data.String.Interpolate
+import Lens.Micro
+import Relude
+import Sauron.Types
+
+
+withScroll :: AppState -> (forall s. ViewportScroll ClickableName -> EventM n s ()) -> EventM n AppState ()
+withScroll s action = do
+  case listSelectedElement (s ^. appMainList) of
+    Just (_, _el@(SomeNode (getEntityData -> EntityData {..}))) -> action $ viewportScroll (InnerViewport [i|viewport_#{_ident}|])
+    _ -> return ()

app/Sauron/Expanding.hs

@@ -25,7 +25,6 @@ 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