warn about failed actions
This commit is contained in:
parent
a0c17c434a
commit
41feee9b37
34
Main.hs
34
Main.hs
@ -138,23 +138,27 @@ main = do
|
||||
E.exitSuccess
|
||||
|
||||
run <- runAction <$> loadSettings opts
|
||||
run "Cookies" deleteCookies
|
||||
run "QuotaManager" deleteQuotaOrigins
|
||||
run "IndexedDB" deleteIndexedDB
|
||||
run "LocalStorage" deleteLocalStorage
|
||||
run "SessionStorage" deleteSessionStorage
|
||||
numFailures <- sum <$> mapM (uncurry run) actions
|
||||
|
||||
if numFailures == 0
|
||||
then E.exitSuccess
|
||||
else do
|
||||
putStrLn ("\nwarning: " <> show numFailures <> " actions have failed")
|
||||
E.exitWith (E.ExitFailure numFailures)
|
||||
|
||||
|
||||
-- | Runs an 'Action' and pretty-prints the results
|
||||
runAction :: Settings -> Text -> Action Result -> IO ()
|
||||
runAction :: Settings -> Text -> Action Result -> IO Int
|
||||
runAction settings name x = do
|
||||
a <- BE.try $ runExceptT (runReaderT x settings)
|
||||
case a of
|
||||
Right (Right res) -> printResult res
|
||||
Right (Left msg) -> printFailed msg
|
||||
Left (err :: BE.IOException) -> printFailed (T.pack $ BE.displayException err)
|
||||
Right (Right res) -> printResult res >> return 0
|
||||
Right (Left msg) -> printFailed msg >> return 1
|
||||
Left (err :: BE.IOException) ->
|
||||
printFailed (T.pack $ BE.displayException err) >> return 1
|
||||
where
|
||||
printFailed msg = T.putStrLn ("- " <> name <> " cleaning failed:\n " <> msg)
|
||||
printFailed msg =
|
||||
T.putStrLn ("- " <> name <> " cleaning failed:\n " <> msg)
|
||||
printResult (n, bad)
|
||||
| n > 0 = do
|
||||
T.putStrLn ("- " <> name <> ": " <> verb <>
|
||||
@ -168,6 +172,16 @@ runAction settings name x = do
|
||||
|
||||
-- * Cleaning actions
|
||||
|
||||
-- | List of actions and their names
|
||||
actions :: [(Text, Action Result)]
|
||||
actions =
|
||||
[ ("Cookies", deleteCookies)
|
||||
, ("QuotaManager", deleteQuotaOrigins)
|
||||
, ("IndexedDB", deleteIndexedDB)
|
||||
, ("LocalStorage", deleteLocalStorage)
|
||||
, ("SessionStorage", deleteSessionStorage)
|
||||
]
|
||||
|
||||
-- | Deletes records in the Cookies database
|
||||
deleteCookies :: Action Result
|
||||
deleteCookies = do
|
||||
|
Loading…
Reference in New Issue
Block a user