From 30dcb0eea4359fccb3d83a2cbdd3b3aa751228f2 Mon Sep 17 00:00:00 2001
From: Jack Kelly <jack@jackkelly.name>
Date: Mon, 26 Aug 2024 13:09:49 +1000
Subject: [PATCH] UUID: Quote the output of `show`

Some packages (e.g., `pretty-simple`) expect strings to contain the
output of `stock`-derived `show`. Using UUIDs with such libraries
necessitates wrangling which can be easily avoided.
---
 uuid-types/ChangeLog.md                    |  5 +++++
 uuid-types/src/Data/UUID/Types/Internal.hs | 17 +++++++++--------
 uuid-types/tests/TestUUID.hs               |  2 +-
 uuid-types/uuid-types.cabal                |  2 +-
 4 files changed, 16 insertions(+), 10 deletions(-)

diff --git a/uuid-types/ChangeLog.md b/uuid-types/ChangeLog.md
index 125bbce..50de5e7 100644
--- a/uuid-types/ChangeLog.md
+++ b/uuid-types/ChangeLog.md
@@ -1,3 +1,8 @@
+## 2.0.0
+
+- Return a quoted string from the `Show` instance, to avoid confusing
+  packages which try to parse stock-derived `show` output.
+
 ## 1.0.6 (2023-04-16)
 
 - Support GHC-8.6.5..GHC-9.10.1
diff --git a/uuid-types/src/Data/UUID/Types/Internal.hs b/uuid-types/src/Data/UUID/Types/Internal.hs
index 83fc898..ae3ff6d 100644
--- a/uuid-types/src/Data/UUID/Types/Internal.hs
+++ b/uuid-types/src/Data/UUID/Types/Internal.hs
@@ -506,20 +506,21 @@ instance Hashable UUID where
           `hashWithSalt` w2
           `hashWithSalt` w3
 
--- | Pretty prints a 'UUID' (without quotation marks). See also 'toString'.
+-- | Pretty prints a 'UUID'. See also 'toString'.
 --
 -- >>> show nil
--- "00000000-0000-0000-0000-000000000000"
+-- "\"00000000-0000-0000-0000-000000000000\""
 --
 instance Show UUID where
-    show = toString
+    show = show . toString
 
 instance Read UUID where
-    readsPrec _ str =
-        let noSpaces = dropWhile isSpace str
-        in case fromString (take 36 noSpaces) of
-          Nothing -> []
-          Just u  -> [(u,drop 36 noSpaces)]
+    readsPrec p quotedStr = do
+      (str, rest) <- readsPrec p quotedStr
+      let noSpaces = dropWhile isSpace str
+      case fromString (take 36 noSpaces) of
+        Nothing -> []
+        Just u  -> [(u, rest)]
 
 -- | This 'Storable' instance uses the memory layout as described in <http://tools.ietf.org/html/rfc4122 RFC 4122>, but in contrast to the 'Binary' instance, __the fields are stored in host byte order__.
 instance Storable UUID where
diff --git a/uuid-types/tests/TestUUID.hs b/uuid-types/tests/TestUUID.hs
index 843b6b8..765021d 100644
--- a/uuid-types/tests/TestUUID.hs
+++ b/uuid-types/tests/TestUUID.hs
@@ -89,7 +89,7 @@ test_Binary =
         (BL8.pack "\xa5\xca\x85\x66\xd9\xc5\x48\x35\x99\xc8\xe1\xf1\x3e\x73\xb5\xe2") @=? encode inputUUID
 
 inputUUID :: U.UUID
-inputUUID = read "a5ca8566-d9c5-4835-99c8-e1f13e73b5e2"
+inputUUID = read $ show "a5ca8566-d9c5-4835-99c8-e1f13e73b5e2"
 
 prop_stringRoundTrip :: Test
 prop_stringRoundTrip = testProperty "String round trip" stringRoundTrip
diff --git a/uuid-types/uuid-types.cabal b/uuid-types/uuid-types.cabal
index 9b7c3cb..95fdb10 100644
--- a/uuid-types/uuid-types.cabal
+++ b/uuid-types/uuid-types.cabal
@@ -1,6 +1,6 @@
 cabal-version:      1.12
 name:               uuid-types
-version:            1.0.6
+version:            2.0.0
 x-revision:         1
 copyright:
   (c) 2017-2018 Herbert Valerio Riedel