@@ -7,18 +7,22 @@ module Sauron.Event.CommentModal (
77 closeWithComment ,
88 refreshIssueComments ,
99 fetchCommentsAndOpenModal ,
10- fetchIssueCommentsAndEvents
10+ fetchIssueCommentsAndEvents ,
11+ openCommentForNotification
1112) where
1213
1314import Brick as B
1415import Brick.BChan
1516import Control.Monad.IO.Unlift
17+ import Data.Char (isDigit )
1618import qualified Data.Text as T
1719import Data.Time
1820import qualified Data.Vector as V
1921import GitHub
2022import Lens.Micro
23+ import Network.URI (parseURI , uriPath )
2124import Relude
25+ import Sauron.Actions.Util (withGithubApiSemaphore , githubWithLogging )
2226import Sauron.Fetch.Issue (fetchIssueCommentsAndEvents )
2327import qualified Sauron.Mutations.Issue as Issue
2428import 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
0 commit comments