about summary refs log tree commit diff
path: root/users/Profpatsch/my-prelude/Label.hs
diff options
context:
space:
mode:
authorProfpatsch <mail@profpatsch.de>2023-01-02T00·34+0100
committerclbot <clbot@tvl.fyi>2023-01-02T02·18+0000
commite6862413ca032acc94615bd969c8fec49a1a1dc5 (patch)
tree7e0a39e799246d23e79d2b4f17be56fbd2ab8e6b /users/Profpatsch/my-prelude/Label.hs
parent1b003db7250949e2589336220ce162bf0b7b6fe3 (diff)
feat(users/Profpatsch/my-prelude): show Label name in Show instance r/5563
Before:

`show (label @"foo" 23) => "Label 23"`

Now:

`show (label @"foo" 42) => "Label @"foo" 42"

Also with good bracketing due to showsPrec (and correct string
escaping of the label).

Change-Id: Ia5448ab9028ef5ab6c0b53407fe4df1d0e40ff5f
Reviewed-on: https://cl.tvl.fyi/c/depot/+/7719
Reviewed-by: Profpatsch <mail@profpatsch.de>
Autosubmit: Profpatsch <mail@profpatsch.de>
Tested-by: BuildkiteCI
Diffstat (limited to 'users/Profpatsch/my-prelude/Label.hs')
-rw-r--r--users/Profpatsch/my-prelude/Label.hs12
1 files changed, 10 insertions, 2 deletions
diff --git a/users/Profpatsch/my-prelude/Label.hs b/users/Profpatsch/my-prelude/Label.hs
index f869343a1e7a..0e339758ddbd 100644
--- a/users/Profpatsch/my-prelude/Label.hs
+++ b/users/Profpatsch/my-prelude/Label.hs
@@ -20,16 +20,24 @@ import Data.Data (Proxy (..))
 import Data.Function ((&))
 import Data.Typeable (Typeable)
 import GHC.Records (HasField (..))
-import GHC.TypeLits (Symbol)
+import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
 
 -- | A labelled value.
 --
 -- Use 'label'/'label'' to construct,
 -- then use dot-syntax to get the inner value.
 newtype Label (label :: Symbol) value = Label value
-  deriving stock (Show, Eq, Ord)
+  deriving stock (Eq, Ord)
   deriving newtype (Typeable)
 
+instance (KnownSymbol label, Show value) => Show (Label label value) where
+  showsPrec d (Label val) =
+    showParen (d > 10) $
+      showString "Label @"
+        . showsPrec 11 (symbolVal (Proxy @label))
+        . showString " "
+        . showsPrec 11 val
+
 -- | Attach a label to a value; should be used with a type application to name the label.
 --
 -- @@