From 8cc79d9531ceefde99ca7664ff7de243f211c243 Mon Sep 17 00:00:00 2001
From: Will Thompson <will@willthompson.co.uk>
Date: Mon, 6 Jul 2020 09:51:16 +0100
Subject: DetailsView: reintroduce special case for error messages

---
 Bustle/GDBusMessage.hs   |  1 -
 Bustle/UI/DetailsView.hs | 22 ++++++++++++----------
 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
-- 
cgit v1.2.3