From fe921bc68e4add55b9b519099c6915c2e6d1130f Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Thu, 9 Sep 2021 21:19:54 +0200
Subject: [PATCH] Add showArgument

---
 src/Quasar/Wayland/Protocol/Core.hs | 12 +++++++++++-
 1 file changed, 11 insertions(+), 1 deletion(-)

diff --git a/src/Quasar/Wayland/Protocol/Core.hs b/src/Quasar/Wayland/Protocol/Core.hs
index b4877e7..a6c40c6 100644
--- a/src/Quasar/Wayland/Protocol/Core.hs
+++ b/src/Quasar/Wayland/Protocol/Core.hs
@@ -92,56 +92,67 @@ class (Eq (Argument a), Show (Argument a)) => WireFormat a where
   type Argument a
   putArgument :: Argument a -> PutM ()
   getArgument :: Get (Argument a)
+  showArgument :: Argument a -> String
 
 instance WireFormat 'IntArgument where
   type Argument 'IntArgument = Int32
   putArgument = putInt32host
   getArgument = getInt32host
+  showArgument = show
 
 instance WireFormat 'UIntArgument where
   type Argument 'UIntArgument = Word32
   putArgument = putWord32host
   getArgument = getWord32host
+  showArgument = show
 
 instance WireFormat 'FixedArgument where
   type Argument 'FixedArgument = Fixed
   putArgument (Fixed repr) = putWord32host repr
   getArgument = Fixed <$> getWord32host
+  showArgument = show
 
 instance WireFormat 'StringArgument where
   type Argument 'StringArgument = BS.ByteString
   putArgument = putWaylandBlob
   getArgument = getWaylandBlob
+  showArgument = show
 
 instance WireFormat 'ArrayArgument where
   type Argument 'ArrayArgument = BS.ByteString
   putArgument = putWaylandBlob
   getArgument = getWaylandBlob
+  showArgument array = "[array " <> show (BS.length array) <> "B]"
 
 instance WireFormat 'ObjectArgument where
   type Argument 'ObjectArgument = ObjectId
   putArgument = putWord32host
   getArgument = getWord32host
+  showArgument oId = "@" <> show oId
 
 instance WireFormat 'UnknownObjectArgument where
   type Argument 'UnknownObjectArgument = ObjectId
   putArgument = putWord32host
   getArgument = getWord32host
+  showArgument oId = "@" <> show oId
 
 instance WireFormat 'NewIdArgument where
   type Argument 'NewIdArgument = NewId
   putArgument (NewId newId) = putWord32host newId
   getArgument = NewId <$> getWord32host
+  showArgument newId = "new @" <> show newId
 
 instance WireFormat 'UnknownNewIdArgument where
   type Argument 'UnknownNewIdArgument = NewId
   putArgument (NewId newId) = putWord32host newId
   getArgument = NewId <$> getWord32host
+  showArgument newId = "new @" <> show newId
 
 instance WireFormat 'FdArgument where
   type Argument 'FdArgument = Void
   putArgument = undefined
   getArgument = undefined
+  showArgument = undefined
 
 
 -- | A wayland interface
@@ -269,7 +280,6 @@ putDynamicArgument (DynamicNewIdArgument x) = putWord32host x
 putDynamicArgument _ = undefined
 
 
-
 type ClientProtocolState m = ProtocolState 'Client m
 type ServerProtocolState m = ProtocolState 'Server m
 
-- 
GitLab