Generalize handleException
This commit is contained in:
parent
3dde41e0d4
commit
5b4caa8ff7
12
src/Main.hs
12
src/Main.hs
@ -6,9 +6,8 @@ module Main
|
|||||||
( main
|
( main
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Exception (Exception(..), handle, SomeException(..))
|
|
||||||
import Data.Char (isNumber)
|
import Data.Char (isNumber)
|
||||||
import Control.Monad.Catch (MonadThrow(..))
|
import Control.Monad.Catch (MonadThrow(..), handle)
|
||||||
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)
|
||||||
@ -257,7 +256,7 @@ autoUpdatable =
|
|||||||
|
|
||||||
up2Date :: Maybe Text -> SlackBuilderT ()
|
up2Date :: Maybe Text -> SlackBuilderT ()
|
||||||
up2Date = \case
|
up2Date = \case
|
||||||
Nothing -> for_ autoUpdatable go
|
Nothing -> for_ autoUpdatable $ handle handleException . go
|
||||||
Just packageName
|
Just packageName
|
||||||
| Just foundPackage <- find ((packageName ==) . getField @"name") autoUpdatable ->
|
| Just foundPackage <- find ((packageName ==) . getField @"name") autoUpdatable ->
|
||||||
go foundPackage
|
go foundPackage
|
||||||
@ -268,7 +267,7 @@ up2Date = \case
|
|||||||
>> liftIO (putStrLn "")
|
>> liftIO (putStrLn "")
|
||||||
|
|
||||||
check :: SlackBuilderT ()
|
check :: SlackBuilderT ()
|
||||||
check = for_ autoUpdatable go
|
check = for_ autoUpdatable $ handle handleException . go
|
||||||
where
|
where
|
||||||
go package = getAndLogLatest package
|
go package = getAndLogLatest package
|
||||||
>>= mapM_ checkUpdateAvailability
|
>>= mapM_ checkUpdateAvailability
|
||||||
@ -290,11 +289,6 @@ main = execParser slackBuilderParser
|
|||||||
>> setSGR [Reset]
|
>> setSGR [Reset]
|
||||||
>> Text.putStr (Toml.prettyTomlDecodeErrors settingsErrors)
|
>> Text.putStr (Toml.prettyTomlDecodeErrors settingsErrors)
|
||||||
configurationFile = "config/config.toml"
|
configurationFile = "config/config.toml"
|
||||||
handleException :: SomeException -> IO ()
|
|
||||||
handleException slackBuilderException
|
|
||||||
= setSGR [SetColor Foreground Dull Red]
|
|
||||||
>> putStrLn (displayException slackBuilderException)
|
|
||||||
>> setSGR [Reset]
|
|
||||||
executeCommand = \case
|
executeCommand = \case
|
||||||
CheckCommand -> check
|
CheckCommand -> check
|
||||||
Up2DateCommand packageName -> up2Date packageName
|
Up2DateCommand packageName -> up2Date packageName
|
||||||
|
@ -7,10 +7,13 @@ module SlackBuilder.Update
|
|||||||
, cloneFromGit
|
, cloneFromGit
|
||||||
, downloadWithTemplate
|
, downloadWithTemplate
|
||||||
, getAndLogLatest
|
, getAndLogLatest
|
||||||
|
, handleException
|
||||||
, reuploadWithTemplate
|
, reuploadWithTemplate
|
||||||
, updatePackageIfRequired
|
, updatePackageIfRequired
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Control.Exception (Exception(..), SomeException(..))
|
||||||
|
import Control.Monad.Catch (MonadCatch(..))
|
||||||
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 qualified Data.ByteString as ByteString
|
import qualified Data.ByteString as ByteString
|
||||||
@ -254,3 +257,9 @@ findCategory packageName = do
|
|||||||
. (currentDirectory </>)
|
. (currentDirectory </>)
|
||||||
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 ()
|
||||||
|
handleException slackBuilderException
|
||||||
|
= liftIO (setSGR [SetColor Foreground Dull Red])
|
||||||
|
>> liftIO (putStrLn (displayException slackBuilderException))
|
||||||
|
>> liftIO (setSGR [Reset])
|
||||||
|
Loading…
Reference in New Issue
Block a user