Skip to content

Commit 69a58b3

Browse files
committed
More UI buttons work + commenting on notifications
1 parent 31112bf commit 69a58b3

6 files changed

Lines changed: 83 additions & 20 deletions

File tree

app/Sauron/Event.hs

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -105,11 +105,13 @@ appEvent s@(_appModal -> Just modalState) e = case e of
105105
modify (appModal . _Just . newIssueBodyEditor .~ bodyEd')
106106
ZoomModalState {} -> case ev of
107107
(V.EvKey V.KEsc []) -> closeModal s
108+
(V.EvKey (V.KChar 'q') []) -> closeModal s
108109
(V.EvKey (V.KChar 'q') [V.MCtrl]) -> closeModal s
109110
(V.EvKey (V.KChar 'c') []) -> handleZoomModalComment s
110111
_ -> whenM (handleModalScrolling ZoomModalContent ev) $ clearAutoScrollTarget s
111112
(LogModalState _) -> case ev of
112113
(V.EvKey V.KEsc []) -> closeModal s
114+
(V.EvKey (V.KChar 'q') []) -> closeModal s
113115
(V.EvKey (V.KChar 'q') [V.MCtrl]) -> closeModal s
114116
(V.EvKey (V.KChar 'c') []) -> modify (appLogs .~ Seq.empty)
115117
(V.EvKey (V.KChar 's') []) -> modify (appShowStackTraces %~ not)
@@ -243,6 +245,8 @@ handleMainPaneEvents' s e = case e of
243245
V.EvKey (V.KChar 'n') [V.MCtrl] -> clearAutoScrollTarget s >> withScroll s (\vp -> vScrollBy vp 1)
244246
V.EvKey (V.KChar 'v') [V.MMeta] -> clearAutoScrollTarget s >> withScroll s (\vp -> vScrollPage vp Up)
245247
V.EvKey (V.KChar 'v') [V.MCtrl] -> clearAutoScrollTarget s >> withScroll s (\vp -> vScrollPage vp Down)
248+
V.EvKey V.KPageUp [] -> clearAutoScrollTarget s >> withScroll s (\vp -> vScrollPage vp Up)
249+
V.EvKey V.KPageDown [] -> clearAutoScrollTarget s >> withScroll s (\vp -> vScrollPage vp Down)
246250
V.EvKey V.KHome [V.MCtrl] -> clearAutoScrollTarget s >> withScroll s (\vp -> vScrollToBeginning vp)
247251
V.EvKey V.KEnd [V.MCtrl] -> clearAutoScrollTarget s >> withScroll s (\vp -> vScrollToEnd vp)
248252

@@ -363,6 +367,9 @@ handleZoomModalComment s = do
363367
Just (RepoNode (EntityData {_static=(owner, name)})) ->
364368
fetchCommentsAndOpenModal (s ^. appBaseContext) issue stateVar True owner name
365369
Nothing -> return ()
370+
Just (ZoomModalState (SomeNode (SingleNotificationNode (EntityData {_static=notification, _state=notifStateVar}))) _parents) -> do
371+
notifState <- liftIO $ readTVarIO notifStateVar
372+
openCommentForNotification (s ^. appBaseContext) notification notifState
366373
_ -> return ()
367374
where
368375
-- findRepoParent expects NonEmpty, but we have a list. Create a dummy NonEmpty.

app/Sauron/Event/CommentModal.hs

Lines changed: 44 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,18 +7,22 @@ module Sauron.Event.CommentModal (
77
closeWithComment,
88
refreshIssueComments,
99
fetchCommentsAndOpenModal,
10-
fetchIssueCommentsAndEvents
10+
fetchIssueCommentsAndEvents,
11+
openCommentForNotification
1112
) where
1213

1314
import Brick as B
1415
import Brick.BChan
1516
import Control.Monad.IO.Unlift
17+
import Data.Char (isDigit)
1618
import qualified Data.Text as T
1719
import Data.Time
1820
import qualified Data.Vector as V
1921
import GitHub
2022
import Lens.Micro
23+
import Network.URI (parseURI, uriPath)
2124
import Relude
25+
import Sauron.Actions.Util (withGithubApiSemaphore, githubWithLogging)
2226
import Sauron.Fetch.Issue (fetchIssueCommentsAndEvents)
2327
import qualified Sauron.Mutations.Issue as Issue
2428
import Sauron.Types
@@ -121,3 +125,42 @@ fetchCommentsAndOpenModal baseContext issue@(Issue {issueNumber=(IssueNumber iss
121125
Left _err -> do
122126
-- On error, open modal with empty comments and events
123127
writeBChan (eventChan baseContext) (CommentModalEvent (OpenCommentModal issue V.empty nodeState isPR owner name))
128+
129+
-- | Open comment modal for a notification that contains an issue or PR.
130+
-- Uses the fetched content if available, otherwise fetches the issue from scratch.
131+
openCommentForNotification :: BaseContext -> Notification -> NotificationState -> EventM ClickableName AppState ()
132+
openCommentForNotification baseContext notification notifState =
133+
case notificationStateContent notifState of
134+
Fetched (NotificationIssue issue comments) -> do
135+
commentsVar <- liftIO $ newTVarIO (Fetched comments)
136+
fetchCommentsAndOpenModal baseContext issue commentsVar False owner name
137+
Fetched (NotificationPull issue comments) -> do
138+
commentsVar <- liftIO $ newTVarIO (Fetched comments)
139+
fetchCommentsAndOpenModal baseContext issue commentsVar True owner name
140+
_ | subjectType subject `elem` ["Issue", "PullRequest"] ->
141+
whenJust (subjectURL subject >>= extractIssueNumber) $ \issueNum ->
142+
liftIO $ fetchIssueAndOpenCommentModal baseContext owner name issueNum (subjectType subject == "PullRequest")
143+
_ -> return ()
144+
where
145+
subject = notificationSubject notification
146+
RepoRef {repoRefOwner=(SimpleOwner {simpleOwnerLogin=owner}), repoRefRepo=name} = notificationRepo notification
147+
148+
fetchIssueAndOpenCommentModal :: BaseContext -> Name Owner -> Name Repo -> Int -> Bool -> IO ()
149+
fetchIssueAndOpenCommentModal baseContext owner name issueNum isPR =
150+
void $ async $ flip runReaderT baseContext $
151+
withGithubApiSemaphore (githubWithLogging (issueR owner name (IssueNumber issueNum))) >>= \case
152+
Left _err -> return ()
153+
Right issue -> liftIO $ do
154+
commentsResult <- fetchIssueCommentsAndEvents baseContext owner name issueNum
155+
commentsVar <- newTVarIO (Fetched (either (const V.empty) id commentsResult))
156+
now <- getCurrentTime
157+
writeBChan (eventChan baseContext) (CommentModalEvent (OpenCommentModal issue (either (const V.empty) id commentsResult) commentsVar isPR owner name))
158+
writeBChan (eventChan baseContext) (TimeUpdated now)
159+
160+
extractIssueNumber :: URL -> Maybe Int
161+
extractIssueNumber (URL url) = do
162+
uri <- parseURI (toString url)
163+
let segments = filter (not . T.null) $ T.splitOn "/" $ toText (uriPath uri)
164+
case reverse (toList segments) of
165+
(idStr:_) | T.all isDigit idStr -> readMaybe (toString idStr)
166+
_ -> Nothing

app/Sauron/Fetch/Notification.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -76,7 +76,7 @@ fetchAsIssueOrPull wrap owner repo subUrl stateVar = do
7676
Fetched x -> Fetching (Just x)
7777
Fetching x -> Fetching x
7878
_ -> Fetching Nothing })
79-
(atomically $ modifyTVar' stateVar $ \ns -> ns { notificationStateContent = Errored "Fetch failed with exception." }) $ do
79+
(atomically $ modifyTVar' stateVar $ \ns -> ns { notificationStateContent = Errored "Fetch failed with exception." }) $
8080
withGithubApiSemaphore (githubWithLogging (issueR owner repo (IssueNumber num))) >>= \case
8181
Left err -> atomically $ modifyTVar' stateVar $ \ns -> ns { notificationStateContent = Errored (show err) }
8282
Right issue ->

app/Sauron/UI/Keys.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -40,10 +40,10 @@ closeReopenKey = V.KChar 'C'
4040
cancelWorkflowKey = V.KChar 'C'
4141
zoomModalKey = V.KChar 'z'
4242
newIssueKey = V.KChar 'c'
43-
markNotificationDoneKey = V.KChar 'd'
43+
markNotificationDoneKey = V.KChar 'D'
4444
markNotificationReadKey = V.KChar 'R'
4545

46-
detailsToggleKey = V.KChar 'D'
46+
detailsToggleKey = V.KChar 'd'
4747

4848
-- Jump-to keys (jump to next node of this type)
4949
jumpToIssuesKey = V.KChar 'i'

app/Sauron/UI/Modals/ZoomModal.hs

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -46,11 +46,15 @@ renderZoomModal _ _ = str "Invalid modal state" -- This should never happen
4646
getZoomModalHotkeys :: SomeNode Fixed -> [Widget ClickableName]
4747
getZoomModalHotkeys (SomeNode node) = nodeSpecificHotkeys ++ commonHotkeys
4848
where
49-
commonHotkeys = [hotkeyWidget "Esc" "Close"]
49+
commonHotkeys = [hotkeyWidget "q" "Close"]
5050

5151
nodeSpecificHotkeys = case node of
5252
SingleIssueNode {} -> [hotkeyWidget (showKey commentKey) "Comment"]
5353
SinglePullNode {} -> [hotkeyWidget (showKey commentKey) "Comment"]
54+
SingleNotificationNode (EntityData {_static=notification}) ->
55+
if subjectType (notificationSubject notification) `elem` ["Issue", "PullRequest"]
56+
then [hotkeyWidget (showKey commentKey) "Comment"]
57+
else []
5458
_ -> []
5559

5660
hotkeyWidget :: String -> String -> Widget ClickableName

app/Sauron/UI/Notification.hs

Lines changed: 24 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,8 @@ import Sauron.Mutations.Notification (markNotificationAsDone, markNotificationAs
2626
import Sauron.Types
2727
import Sauron.UI.AttrMap
2828
import Sauron.UI.Issue (renderTimelineItemWithAttr, consolidateEvents, TimelineItem(..), detailsToggleWidget)
29-
import Sauron.UI.Keys (markNotificationDoneKey, markNotificationReadKey, zoomModalKey, showKey)
29+
import Sauron.Event.CommentModal (openCommentForNotification)
30+
import Sauron.UI.Keys (commentKey, markNotificationDoneKey, markNotificationReadKey, zoomModalKey, showKey)
3031
import Sauron.UI.Statuses (fetchableQuarterCircleSpinner)
3132
import Sauron.UI.Util.TimeDiff (timeFromNow)
3233
import qualified System.FilePath.Posix as FP
@@ -43,34 +44,42 @@ instance ListDrawable Fixed 'SingleNotificationT where
4344

4445
getExtraTopBoxWidgets appState (EntityData {_static=notification}) =
4546
[hBox [str "["
46-
, withAttr hotkeyAttr $ str $ showKey markNotificationDoneKey
47-
, str "] "
48-
, withAttr hotkeyMessageAttr $ str "Mark done"
49-
]
47+
, withAttr hotkeyAttr $ str $ showKey markNotificationReadKey
48+
, str "/"
49+
, withAttr hotkeyAttr $ str $ showKey markNotificationDoneKey
50+
, str "] "
51+
, withAttr hotkeyMessageAttr $ str "Mark read/done"
52+
]
5053
]
51-
++ (if notificationUnread notification
52-
then [hBox [str "["
53-
, withAttr hotkeyAttr $ str $ showKey markNotificationReadKey
54-
, str "] "
55-
, withAttr hotkeyMessageAttr $ str "Mark read"
56-
]
57-
]
58-
else []
59-
)
6054
++ [hBox [str "["
6155
, withAttr hotkeyAttr $ str $ showKey zoomModalKey
6256
, str "] "
6357
, withAttr hotkeyMessageAttr $ str "Zoom"
6458
]
65-
, detailsToggleWidget appState
6659
]
60+
++ (if subjectType (notificationSubject notification) `elem` ["Issue", "PullRequest"]
61+
then [hBox [str "["
62+
, withAttr hotkeyAttr $ str $ showKey commentKey
63+
, str "] "
64+
, withAttr hotkeyMessageAttr $ str "Comment"
65+
]]
66+
else [])
67+
++ [detailsToggleWidget appState]
6768

6869
handleHotkey appState key (EntityData {_static=notification})
6970
| key == zoomModalKey = do
7071
withFixedElemAndParents appState $ \(SomeNode _) (SomeNode variableEl) parents -> do
7172
refreshOnZoom (appState ^. appBaseContext) variableEl parents
7273
liftIO $ atomically $ writeTVar (_appModalVariable appState) (Just (ZoomModalState (SomeNode variableEl) (toList parents)))
7374
return True
75+
| key == commentKey = do
76+
withFixedElemAndParents appState $ \_ (SomeNode variableEl) _parents ->
77+
case variableEl of
78+
SingleNotificationNode (EntityData {_state=notifStateVar}) -> do
79+
notifState <- liftIO $ readTVarIO notifStateVar
80+
openCommentForNotification (appState ^. appBaseContext) notification notifState
81+
_ -> return ()
82+
return True
7483
| key == markNotificationDoneKey = do
7584
liftIO $ void $ async $ do
7685
runReaderT (markNotificationAsDone notification) (appState ^. appBaseContext)

0 commit comments

Comments
 (0)