@@ -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
2123import Brick.BChan
2224import Control.Concurrent.QSem
2325import Control.Exception.Safe (bracket_ )
2426import Control.Monad.Catch (MonadMask )
2527import Control.Monad.IO.Class
26- import Control.Monad.Logger (LogLevel (.. ))
2728import Control.Monad.Reader
2829import Data.Aeson (FromJSON )
2930import qualified Data.ByteString as BS
30- import qualified Data.ByteString.Lazy as LBS
3131import Data.ByteString.Builder (intDec , toLazyByteString )
32+ import qualified Data.ByteString.Lazy as LBS
3233import qualified Data.List as L
34+ import Data.String.Interpolate
3335import qualified Data.Text as T
3436import Data.Time
3537import GitHub
3638import Network.HTTP.Client (Response , responseBody , responseHeaders )
3739import Network.HTTP.Types (EscapeItem (.. ))
3840import Network.HTTP.Types.Header (hContentLength )
3941import Relude
42+ import Sauron.Logging
4043import Sauron.Types
4144import UnliftIO.Process
4245
@@ -73,11 +76,14 @@ findRepoParent elems = viaNonEmpty head [x | SomeNode x@(RepoNode _) <- toList e
7376findJobParent :: [SomeNode Variable ] -> Maybe (Node Variable SingleJobT )
7477findJobParent 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
7783requestToUrl 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 ()
127144logResult eventChan request result maybeDuration = do
128145 now <- liftIO getCurrentTime
129146 let url = requestToUrl request
0 commit comments