DetailsView: reintroduce special case for error messages

2 files changed, 12 insertions, 11 deletions

diff --git a/Bustle/GDBusMessage.hs b/Bustle/GDBusMessage.hs
index 030c106..5aa68c0 100644
--- a/Bustle/GDBusMessage.hs
+++ b/Bustle/GDBusMessage.hs
@@ -72,7 +72,6 @@ import Foreign.Marshal.Alloc
 import System.Glib.GObject
 import System.Glib.UTFString
 
-import Control.Monad (guard)
 import Control.Monad.Trans (liftIO)
 import Control.Monad.Trans.Maybe
 
diff --git a/Bustle/UI/DetailsView.hs b/Bustle/UI/DetailsView.hs
index e1fa995..7b8ef63 100644
--- a/Bustle/UI/DetailsView.hs
+++ b/Bustle/UI/DetailsView.hs
@@ -24,6 +24,9 @@ module Bustle.UI.DetailsView
   )
 where
 
+import Control.Monad.Trans (liftIO)
+import Control.Monad.Trans.Maybe (MaybeT(..))
+
 import Graphics.UI.Gtk hiding (Signal)
 
 import Bustle.Types
@@ -90,17 +93,16 @@ getErrorName :: Detailed a -> IO (Maybe String)
 getErrorName (Detailed _ _ _ m) = messageErrorName m
 
 formatMessage :: Detailed Message -> IO String
-formatMessage (Detailed _ _ _ m) = messagePrintBody m
-{- TODO reintroduce special case?
-    case (rm, D.fromVariant <$> body) of
-        -- Special-case errors, which (are supposed to) have a single
-        -- human-readable string argument
-        (D.ReceivedMethodError _ _, [Just message]) -> message
-        _                                           -> formatted
+formatMessage (Detailed _ _ _ m) = do
+    errorMessage <- formatErrorMessage
+    case errorMessage of
+        Just message -> return message
+        Nothing      -> messagePrintBody m
   where
-    body = D.receivedMessageBody rm
-    formatted = intercalate "\n" $ map (format_Variant VariantStyleSignature) body
-    -}
+    formatErrorMessage :: IO (Maybe String)
+    formatErrorMessage = runMaybeT $ do
+        MessageTypeError <- liftIO $ messageType m
+        MaybeT $ messageGetBodyString m 0
 
 detailsViewGetTop :: DetailsView -> Widget
 detailsViewGetTop = toWidget . detailsGrid