Skip to content

Commit 2431ccd

Browse files
committed
Working on notification mutations
1 parent 7728b0d commit 2431ccd

5 files changed

Lines changed: 55 additions & 29 deletions

File tree

app/Sauron/Actions/Util.hs

Lines changed: 22 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -11,32 +11,35 @@ module Sauron.Actions.Util (
1111
, githubWithLoggingResponse
1212
, githubWithLogging'
1313
, githubWithLogging''
14+
, githubWithLoggingUnit
1415

1516
, openBrowserToUrl
1617

1718
, findRepoParent
1819
, findJobParent
20+
, findNotificationsParent
1921
) where
2022

2123
import Brick.BChan
2224
import Control.Concurrent.QSem
2325
import Control.Exception.Safe (bracket_)
2426
import Control.Monad.Catch (MonadMask)
2527
import Control.Monad.IO.Class
26-
import Control.Monad.Logger (LogLevel(..))
2728
import Control.Monad.Reader
2829
import Data.Aeson (FromJSON)
2930
import qualified Data.ByteString as BS
30-
import qualified Data.ByteString.Lazy as LBS
3131
import Data.ByteString.Builder (intDec, toLazyByteString)
32+
import qualified Data.ByteString.Lazy as LBS
3233
import qualified Data.List as L
34+
import Data.String.Interpolate
3335
import qualified Data.Text as T
3436
import Data.Time
3537
import GitHub
3638
import Network.HTTP.Client (Response, responseBody, responseHeaders)
3739
import Network.HTTP.Types (EscapeItem(..))
3840
import Network.HTTP.Types.Header (hContentLength)
3941
import Relude
42+
import Sauron.Logging
4043
import Sauron.Types
4144
import UnliftIO.Process
4245

@@ -73,11 +76,14 @@ findRepoParent elems = viaNonEmpty head [x | SomeNode x@(RepoNode _) <- toList e
7376
findJobParent :: [SomeNode Variable] -> Maybe (Node Variable SingleJobT)
7477
findJobParent elems = viaNonEmpty head [x | SomeNode x@(SingleJobNode _) <- toList elems]
7578

76-
requestToUrl :: Request k a -> Text
79+
findNotificationsParent :: NonEmpty (SomeNode Variable) -> Maybe (Node Variable PaginatedNotificationsT)
80+
findNotificationsParent elems = viaNonEmpty head [x | SomeNode x@(PaginatedNotificationsNode _) <- toList elems]
81+
82+
requestToUrl :: GenRequest mt k a -> Text
7783
requestToUrl req = case req of
7884
Query paths queryString -> pathsToUrl paths <> formatQueryString queryString
7985
PagedQuery paths queryString fetchCount -> pathsToUrl paths <> formatQueryString (queryString <> extraQueryItems fetchCount)
80-
Command _method paths _body -> pathsToUrl paths
86+
Command method paths _body -> show method <> " " <> pathsToUrl paths
8187
where
8288
pathsToUrl :: [Text] -> Text
8389
pathsToUrl = ("/" <>) . T.intercalate "/"
@@ -123,7 +129,18 @@ githubWithLogging'' (BaseContext {..}) request = withFrozenCallStack $ do
123129
logResult eventChan request result (Just duration)
124130
return result
125131

126-
logResult :: (HasCallStack, MonadIO m) => BChan AppEvent -> Request k a -> Either Error (Response b) -> Maybe NominalDiffTime -> m ()
132+
githubWithLoggingUnit :: (HasCallStack, MonadReader BaseContext m, MonadIO m) => GenRequest 'MtUnit rw () -> m (Either Error ())
133+
githubWithLoggingUnit request = withFrozenCallStack $ do
134+
BaseContext {..} <- ask
135+
startTime <- liftIO getCurrentTime
136+
result <- liftIO $ executeRequestWithMgrAndRes manager auth request
137+
endTime <- liftIO getCurrentTime
138+
let duration = diffUTCTime endTime startTime
139+
logResult eventChan request result (Just duration)
140+
info [i|result: #{result}|]
141+
return (fmap responseBody result)
142+
143+
logResult :: (HasCallStack, MonadIO m) => BChan AppEvent -> GenRequest mt k a -> Either Error (Response b) -> Maybe NominalDiffTime -> m ()
127144
logResult eventChan request result maybeDuration = do
128145
now <- liftIO getCurrentTime
129146
let url = requestToUrl request

app/Sauron/Mutations/Notification.hs

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -10,22 +10,22 @@ import Control.Monad.Catch (MonadMask)
1010
import Control.Monad.IO.Class
1111
import GitHub
1212
import Relude
13-
import Sauron.Actions.Util (withGithubApiSemaphore)
13+
import Sauron.Actions.Util
1414
import Sauron.Logging
1515
import Sauron.Types
1616

1717
markNotificationAsRead :: (
1818
MonadReader BaseContext m, MonadIO m, MonadMask m
1919
) => Notification -> m ()
20-
markNotificationAsRead notification = do
21-
bc@(BaseContext {auth, manager}) <- ask
22-
23-
withGithubApiSemaphore (liftIO $ executeRequestWithMgrAndRes manager auth (markNotificationAsReadR (notificationId notification))) >>= \case
24-
Left err -> logError' bc $ "Failed to mark notification as read: " <> show err
20+
markNotificationAsRead notification =
21+
withGithubApiSemaphore (githubWithLoggingUnit (markNotificationAsReadR (notificationId notification))) >>= \case
22+
Left err -> logError $ "Failed to mark notification as read: " <> show err
2523
Right _ -> return ()
2624

2725
markNotificationAsDone :: (
2826
MonadReader BaseContext m, MonadIO m, MonadMask m
2927
) => Notification -> m ()
30-
markNotificationAsDone notification = do
31-
markNotificationAsRead notification
28+
markNotificationAsDone notification =
29+
withGithubApiSemaphore (githubWithLoggingUnit (markNotificationAsDoneR (notificationId notification))) >>= \case
30+
Left err -> logError $ "Failed to mark notification as done: " <> show err
31+
Right _ -> return ()

app/Sauron/UI/Notification.hs

Lines changed: 19 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE GADTs #-}
23
{-# LANGUAGE MultiParamTypeClasses #-}
34
{-# OPTIONS_GHC -fno-warn-orphans #-}
45

@@ -14,7 +15,8 @@ import Data.Time
1415
import GitHub
1516
import Lens.Micro
1617
import Relude
17-
import Sauron.Actions (refreshSelected)
18+
import Sauron.Actions (refreshLine)
19+
import Sauron.Actions.Util (findNotificationsParent)
1820
import Sauron.Event.Helpers (withFixedElemAndParents)
1921
import Sauron.Mutations.Notification (markNotificationAsDone, markNotificationAsRead)
2022
import Sauron.Types
@@ -29,7 +31,7 @@ instance ListDrawable Fixed 'SingleNotificationT where
2931
drawLine appState (EntityData {_static=notification, ..}) =
3032
notificationLine (_appNow appState) _toggled notification (_appAnimationCounter appState) _state
3133

32-
drawInner appState (EntityData {_static=notification, _ident, ..}) = do
34+
drawInner appState (EntityData {_static=notification, ..}) = do
3335
guard _toggled
3436
return $ notificationInner (_appNow appState) notification
3537

@@ -40,30 +42,35 @@ instance ListDrawable Fixed 'SingleNotificationT where
4042
, withAttr hotkeyMessageAttr $ str "Mark done"
4143
]
4244
]
43-
++ (
44-
if notificationUnread notification
45+
++ (if notificationUnread notification
4546
then [hBox [str "["
4647
, withAttr hotkeyAttr $ str $ showKey markNotificationReadKey
4748
, str "] "
4849
, withAttr hotkeyMessageAttr $ str "Mark read"
4950
]
5051
]
5152
else []
52-
)
53+
)
5354

5455
handleHotkey appState key (EntityData {_static=notification})
55-
| key == markNotificationDoneKey && notificationUnread notification = do
56-
liftIO $ void $ async $ runReaderT (markNotificationAsDone notification) (appState ^. appBaseContext)
57-
withFixedElemAndParents appState $ \_fixedEl (SomeNode variableEl) parents ->
58-
refreshSelected (appState ^. appBaseContext) variableEl parents
56+
| key == markNotificationDoneKey = do
57+
liftIO $ void $ async $ do
58+
runReaderT (markNotificationAsDone notification) (appState ^. appBaseContext)
59+
refreshParentNotifications appState
5960
return True
6061
| key == markNotificationReadKey && notificationUnread notification = do
61-
liftIO $ void $ async $ runReaderT (markNotificationAsRead notification) (appState ^. appBaseContext)
62-
withFixedElemAndParents appState $ \_fixedEl (SomeNode variableEl) parents ->
63-
refreshSelected (appState ^. appBaseContext) variableEl parents
62+
liftIO $ void $ async $ do
63+
runReaderT (markNotificationAsRead notification) (appState ^. appBaseContext)
64+
refreshParentNotifications appState
6465
return True
6566
handleHotkey _ _ _ = return False
6667

68+
refreshParentNotifications :: MonadIO m => AppState -> m ()
69+
refreshParentNotifications appState =
70+
withFixedElemAndParents appState $ \_ _ parents ->
71+
whenJust (findNotificationsParent parents) $ \notificationsNode ->
72+
liftIO $ void $ refreshLine (appState ^. appBaseContext) notificationsNode parents
73+
6774
notificationLine :: UTCTime -> Bool -> Notification -> Int -> Fetchable a -> Widget n
6875
notificationLine now toggled' (Notification {..}) animationCounter fetchableState = vBox [line1, line2]
6976
where

stack.yaml

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,9 @@ extra-deps:
2424
# - Repo: add subscribers_count
2525
# - Fix getNotificationsR
2626
# - EventType: add more constructors + a catchall called Unknown
27-
commit: 73099ec89571b1819ecf6283d2b3957bd0dff31d
27+
# - Fix markNotificationAsReadR
28+
# - Add markNotificationAsDoneR
29+
commit: 23294bf9e64c358f2c907d12bd88e89696c34818
2830

2931
- git: https://github.com/dogonthehorizon/git-config.git
3032
commit: 8f3fab100e4c8d82b5c6fe7c0cc09510249e98cf

stack.yaml.lock

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -19,15 +19,15 @@ packages:
1919
original:
2020
hackage: brick-skylighting-1.0@sha256:64764b6be36c05261959f68ed38b9cb37e1acb6180a3bde5dd98255f62ea7e3b,1812
2121
- completed:
22-
commit: 73099ec89571b1819ecf6283d2b3957bd0dff31d
22+
commit: 23294bf9e64c358f2c907d12bd88e89696c34818
2323
git: https://github.com/codedownio/github.git
2424
name: github
2525
pantry-tree:
26-
sha256: 6715636da6c4dce584849af9680758d491e43fc9bc11eabd6903d3df59abfd5f
26+
sha256: 61701648cb648ce75d6fdcf8dcdceccf7d80288b1143a300fc6b1cb3a4db077a
2727
size: 19297
2828
version: 0.30.0.1
2929
original:
30-
commit: 73099ec89571b1819ecf6283d2b3957bd0dff31d
30+
commit: 23294bf9e64c358f2c907d12bd88e89696c34818
3131
git: https://github.com/codedownio/github.git
3232
- completed:
3333
commit: 8f3fab100e4c8d82b5c6fe7c0cc09510249e98cf

0 commit comments

Comments
 (0)