From 68ac4d3ae6f37a2f73109f65f67e0b0d209696f0 Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Sat, 2 May 2020 18:37:58 +0530 Subject: Update stderr and the bar on receiving exception --- src/Xmobar/Plugins/StdinReader.hs | 9 +++++++-- src/Xmobar/Run/Exec.hs | 2 +- src/Xmobar/System/Utils.hs | 13 ++++++++++++- 3 files changed, 20 insertions(+), 4 deletions(-) diff --git a/src/Xmobar/Plugins/StdinReader.hs b/src/Xmobar/Plugins/StdinReader.hs index 18958be..ad7291e 100644 --- a/src/Xmobar/Plugins/StdinReader.hs +++ b/src/Xmobar/Plugins/StdinReader.hs @@ -22,16 +22,21 @@ import Prelude import System.Posix.Process import System.Exit import System.IO -import Control.Exception (SomeException(..), handle) import Xmobar.Run.Exec import Xmobar.X11.Actions (stripActions) +import Xmobar.System.Utils (onSomeException) data StdinReader = StdinReader | UnsafeStdinReader deriving (Read, Show) instance Exec StdinReader where start stdinReader cb = do - s <- getLine + s <- + getLine `onSomeException` + (\e -> do + let errorMessage = "xmobar: Received exception " <> show e + hPrint stderr errorMessage + cb errorMessage) cb $ escape stdinReader s eof <- isEOF if eof diff --git a/src/Xmobar/Run/Exec.hs b/src/Xmobar/Run/Exec.hs index d8cf81a..e1b6709 100644 --- a/src/Xmobar/Run/Exec.hs +++ b/src/Xmobar/Run/Exec.hs @@ -10,7 +10,7 @@ -- -- The 'Exec' class and the 'Command' data type. -- --- The 'Exec' class rappresents the executable types, whose constructors may +-- The 'Exec' class represents the executable types, whose constructors may -- appear in the 'Config.commands' field of the 'Config.Config' data type. -- -- The 'Command' data type is for OS commands to be run by xmobar diff --git a/src/Xmobar/System/Utils.hs b/src/Xmobar/System/Utils.hs index 636436b..59c485c 100644 --- a/src/Xmobar/System/Utils.hs +++ b/src/Xmobar/System/Utils.hs @@ -17,7 +17,7 @@ ------------------------------------------------------------------------------ -module Xmobar.System.Utils (expandHome, changeLoop) +module Xmobar.System.Utils (expandHome, changeLoop, onSomeException) where import Control.Monad @@ -25,6 +25,7 @@ import Control.Concurrent.STM import System.Environment import System.FilePath +import Control.Exception expandHome :: FilePath -> IO FilePath expandHome ('~':'/':path) = fmap ( path) (getEnv "HOME") @@ -39,3 +40,13 @@ changeLoop s f = atomically s >>= go new <- s guard (new /= old) return new) + +-- | Like 'finally', but only performs the final action if there was an +-- exception raised by the computation. +-- +-- Note that this implementation is a slight modification of +-- onException function. +onSomeException :: IO a -> (SomeException -> IO b) -> IO a +onSomeException io what = io `catch` \e -> do _ <- what e + throwIO (e :: SomeException) + -- cgit v1.2.3