From a2cf97581b82683f45f50b556b36679cd0fa4e1f Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Tue, 21 Sep 2021 16:13:05 +0200
Subject: [PATCH] Add WlString type with UTF8-conversion functions

---
 src/Quasar/Wayland/Protocol.hs      |  1 +
 src/Quasar/Wayland/Protocol/Core.hs | 30 +++++++++++++++++++++++++----
 2 files changed, 27 insertions(+), 4 deletions(-)

diff --git a/src/Quasar/Wayland/Protocol.hs b/src/Quasar/Wayland/Protocol.hs
index 8f85cf3..ac0cf01 100644
--- a/src/Quasar/Wayland/Protocol.hs
+++ b/src/Quasar/Wayland/Protocol.hs
@@ -8,6 +8,7 @@ module Quasar.Wayland.Protocol (
   GenericObjectId,
   NewId,
   Fixed(..),
+  WlString(..),
 
   -- ** Classes for generated interfaces
   IsInterface(Request, Event, InterfaceName, interfaceName),
diff --git a/src/Quasar/Wayland/Protocol/Core.hs b/src/Quasar/Wayland/Protocol/Core.hs
index 49af852..abd711c 100644
--- a/src/Quasar/Wayland/Protocol/Core.hs
+++ b/src/Quasar/Wayland/Protocol/Core.hs
@@ -7,6 +7,9 @@ module Quasar.Wayland.Protocol.Core (
   Opcode,
   ArgumentType(..),
   Fixed(..),
+  WlString(..),
+  toString,
+  fromString,
   IsSide(..),
   Side(..),
   IsInterface(..),
@@ -63,9 +66,11 @@ import Data.Bits ((.&.), (.|.), shiftL, shiftR)
 import Data.ByteString (ByteString)
 import Data.ByteString qualified as BS
 import Data.ByteString.Lazy qualified as BSL
+import Data.ByteString.UTF8 qualified as BSUTF8
 import Data.HashMap.Strict (HashMap)
 import Data.HashMap.Strict qualified as HM
 import Data.Proxy
+import Data.String (IsString(..))
 import Data.Void (absurd)
 import GHC.TypeLits
 import Language.Haskell.TH.Syntax (Lift)
@@ -79,6 +84,14 @@ type GenericObjectId = Word32
 
 type Opcode = Word16
 
+
+newtype NewId (j :: Symbol) = NewId GenericObjectId
+  deriving stock (Eq, Show)
+
+newtype GenericNewId = GenericNewId GenericObjectId
+  deriving stock (Eq, Show)
+
+
 -- | Signed 24.8 decimal numbers.
 newtype Fixed = Fixed Word32
   deriving newtype Eq
@@ -86,11 +99,20 @@ newtype Fixed = Fixed Word32
 instance Show Fixed where
   show x = "[fixed " <> show x <> "]"
 
-newtype NewId (j :: Symbol) = NewId GenericObjectId
-  deriving stock (Eq, Show)
 
-newtype GenericNewId = GenericNewId GenericObjectId
-  deriving stock (Eq, Show)
+-- | A string. The encoding is not officially specified, but in practice UTF-8 is used.
+--
+-- Instances and functions in this library assume UTF-8, but the original data is also available by deconstructing.
+newtype WlString = WlString BS.ByteString
+
+instance Show WlString where
+  show = show . toString
+
+instance IsString WlString where
+  fromString = WlString . BSUTF8.fromString
+
+toString :: WlString -> String
+toString (WlString bs) = BSUTF8.toString bs
 
 
 dropRemaining :: Get ()
-- 
GitLab