OSS/slackbuilder
1
0
Fork 0
Code Issues 2 Pull Requests Actions Releases Activity

Print shorter http exceptions
All checks were successful
Build / audit (push) Successful in 8s
Details
Build / test (push) Successful in 15m14s
Details

Browse Source
This commit is contained in:
Eugen Wissner 2024-12-13 19:44:30 +01:00
parent e1ece39147
commit d043ba8844
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
2 changed files with 27 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Main.hs
View File

@ -6,7 +6,7 @@ module Main
( main ( main
) where ) where
import Control.Monad.Catch (MonadThrow(..), handle) import Control.Monad.Catch (MonadThrow(..))
import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.IO.Class (MonadIO(..))
import qualified Data.Map as Map import qualified Data.Map as Map
import Options.Applicative (execParser) import Options.Applicative (execParser)
@ -84,7 +84,7 @@ up2Date :: Maybe Text -> SlackBuilderT ()
up2Date selectedPackage = do up2Date selectedPackage = do
packages' <- SlackBuilderT $ asks (getField @"packages") packages' <- SlackBuilderT $ asks (getField @"packages")
case selectedPackage of case selectedPackage of
Nothing -> traverse_ (handle handleException . go) $ autoUpdatable packages' Nothing -> traverse_ (handleExceptions . go) $ autoUpdatable packages'
Just packageName Just packageName
| Just foundPackage <- find ((packageName ==) . getField @"name") (autoUpdatable packages') -> | Just foundPackage <- find ((packageName ==) . getField @"name") (autoUpdatable packages') ->
go foundPackage go foundPackage
@ -96,7 +96,7 @@ up2Date selectedPackage = do
check :: SlackBuilderT () check :: SlackBuilderT ()
check = SlackBuilderT (asks (getField @"packages")) check = SlackBuilderT (asks (getField @"packages"))
>>= traverse_ (handle handleException . go) . autoUpdatable >>= traverse_ (handleExceptions . go) . autoUpdatable
where where
go package = getAndLogLatest package go package = getAndLogLatest package
>>= mapM_ checkUpdateAvailability >>= mapM_ checkUpdateAvailability
@ -130,7 +130,7 @@ installed = do
main :: IO () main :: IO ()
main = execParser slackBuilderParser main = execParser slackBuilderParser
>>= handle handleException . withCommandLine >>= handleExceptions . withCommandLine
where where
withCommandLine programCommand = do withCommandLine programCommand = do
settingsResult <- Toml.decodeFileEither settingsCodec configurationFile settingsResult <- Toml.decodeFileEither settingsCodec configurationFile

27
src/SlackBuilder/Update.hs
View File

@ -7,7 +7,7 @@ module SlackBuilder.Update
, cloneFromGit , cloneFromGit
, downloadWithTemplate , downloadWithTemplate
, getAndLogLatest , getAndLogLatest
, handleException , handleExceptions
, listRepository , listRepository
, repackageWithTemplate , repackageWithTemplate
, reuploadWithTemplate , reuploadWithTemplate
@ -15,7 +15,7 @@ module SlackBuilder.Update
) where ) where
import Control.Exception (Exception(..), SomeException(..)) import Control.Exception (Exception(..), SomeException(..))
import Control.Monad.Catch (MonadCatch(..)) import Control.Monad.Catch (MonadCatch(..), catches, Handler(..))
import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.Reader (asks) import Control.Monad.Trans.Reader (asks)
import Data.Foldable (Foldable(..), find) import Data.Foldable (Foldable(..), find)
@ -27,6 +27,8 @@ import Data.Text (Text)
import qualified Data.Text as Text import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO import qualified Data.Text.IO as Text.IO
import GHC.Records (HasField(..)) import GHC.Records (HasField(..))
import qualified Network.HTTP.Req as Req
import Network.HTTP.Client (HttpException(..))
import System.FilePath import System.FilePath
( (</>) ( (</>)
, (<.>) , (<.>)
@ -65,7 +67,7 @@ import System.Console.ANSI
, Color(..) , Color(..)
, ConsoleLayer(..) , ConsoleLayer(..)
) )
import Control.Monad (filterM) import Control.Monad (filterM, void)
import Data.List (isPrefixOf, isSuffixOf, partition) import Data.List (isPrefixOf, isSuffixOf, partition)
import Data.Functor ((<&>)) import Data.Functor ((<&>))
import Data.Bifunctor (Bifunctor(..)) import Data.Bifunctor (Bifunctor(..))
@ -266,8 +268,21 @@ listRepository = do
in filterM directoryFilter accumulatedDirectories in filterM directoryFilter accumulatedDirectories
>>= traverse (go currentDirectory found) <&> concat >>= traverse (go currentDirectory found) <&> concat
handleException :: (MonadIO m, MonadCatch m) => SomeException -> m () handleExceptions :: (MonadIO m, MonadCatch m) => forall a. m a -> m ()
handleException slackBuilderException handleExceptions action = catches (void action)
[ Handler handleHttp
, Handler handleSome
]
where
printException e
= liftIO (setSGR [SetColor Foreground Dull Red]) = liftIO (setSGR [SetColor Foreground Dull Red])
>> liftIO (putStrLn (displayException slackBuilderException)) >> liftIO (putStrLn e)
>> liftIO (setSGR [Reset]) >> liftIO (setSGR [Reset])
handleHttp :: (MonadIO m, MonadCatch m) => Req.HttpException -> m ()
handleHttp (Req.VanillaHttpException e)
| HttpExceptionRequest _ exceptionContent <- e = printException
$ show exceptionContent
| InvalidUrlException url reason <- e = printException $ url <> ": " <> reason
handleHttp (Req.JsonHttpException e) = printException e
handleSome :: (MonadIO m, MonadCatch m) => SomeException -> m ()
handleSome = printException . displayException