Skip to content

Commit

Permalink
Change Show-instances to use "#field := val"
Browse files Browse the repository at this point in the history
The previous show instance would add another layer of quoting for each
nesting:

```
ghci> show (rcons (#foo := "bar") rnil)
"[(\"foo\",\"\\\"bar\\\"\")]"
```

Instead, what we want is to display a nicely readable variant of the
record, using the infix field syntax for both label/value pairs and
full records:

```
ghci> show (rcons (#hi := (rcons (#lea := "hi") rnil)) (rcons (#foo := "bar") rnil ))
"[#foo := \"bar\",#hi := [(#lea := \"hi\")]]"

ghci> show (#hi := "lea")
"#hi := \"lea\""
```

That’s better!

Note that we can’t have a roundtripping `Read` instance anyway, so we
might as well have `Show` be readable.

Fixes #36
  • Loading branch information
Profpatsch committed Nov 10, 2022
1 parent 5a7d686 commit 23d3873
Show file tree
Hide file tree
Showing 3 changed files with 16 additions and 4 deletions.
10 changes: 9 additions & 1 deletion src/SuperRecord.hs
Original file line number Diff line number Diff line change
Expand Up @@ -101,6 +101,7 @@ import Data.Kind (Type)

#if MIN_VERSION_aeson(2, 0, 0)
import qualified Data.Aeson.Key as Key
import Text.Show (showListWith)
#else
import qualified Data.Text as T
#endif
Expand Down Expand Up @@ -160,7 +161,7 @@ class ( c1 k a b, c2 k a b ) => Tuple222C c1 c2 k a b
instance ( c1 k a b, c2 k a b ) => Tuple222C c1 c2 k a b

instance (RecApply lts lts (ConstC Show)) => Show (Rec lts) where
show = show . showRec
showsPrec = showsPrecRec

instance RecApply lts lts (Tuple22C (ConstC Eq) (Has lts)) => Eq (Rec lts) where
r1 == r2 = recApply @lts @lts @(Tuple22C (ConstC Eq) (Has lts)) ( \lbl v b -> get lbl r2 == v && b ) r1 True
Expand Down Expand Up @@ -712,6 +713,13 @@ reflectRecFold f r =
showRec :: forall lts. (RecApply lts lts (ConstC Show)) => Rec lts -> [(String, String)]
showRec = reflectRec @(ConstC Show) (\(_ :: FldProxy lbl) v -> (symbolVal' (proxy# :: Proxy# lbl), show v))

showsPrecRec :: forall lts. (RecApply lts lts (ConstC Show)) => Int -> Rec lts -> ShowS
showsPrecRec d r =
showListWith id $
reflectRec
@(ConstC Show) (\(lbl :: FldProxy lbl) v -> showsPrec d (lbl := v))
r

recToValue :: forall lts. (RecApply lts lts (ConstC ToJSON)) => Rec lts -> Value
recToValue r = object $ reflectRec @(ConstC ToJSON) (\(_ :: FldProxy lbl) v -> (jsonKey $ symbolVal' (proxy# :: Proxy# lbl), toJSON v)) r

Expand Down
8 changes: 6 additions & 2 deletions src/SuperRecord/Field.hs
Original file line number Diff line number Diff line change
Expand Up @@ -29,8 +29,12 @@ instance (Ord value) => Ord (label := value) where

instance (Show t) =>
Show (l := t) where
showsPrec p (l := t) =
showParen (p > 10) (showString ("#" ++ symbolVal l ++ " := " ++ show t))
showsPrec d (l := t) =
showParen (d > labelPrec) $
showString ("#" ++ symbolVal l ++ " := ")
. showsPrec (labelPrec+1) t
where
labelPrec = 6

-- | A proxy witness for a label. Very similar to 'Proxy', but needed to implement
-- a non-orphan 'IsLabel' instance
Expand Down
2 changes: 1 addition & 1 deletion test/Spec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -351,7 +351,7 @@ recordTests =
do let vals = showRec r1
vals `shouldBe` [("foo", "\"Hi\""), ("int", "213")]
it "show works" $
show r1 `shouldBe` "[(\"foo\",\"\\\"Hi\\\"\"),(\"int\",\"213\")]"
show r1 `shouldBe` "[#foo := \"Hi\",#int := 213]"
it "equality works" $
do r1 == r1 `shouldBe` True
r1 == set #foo "Hai" r1 `shouldBe` False
Expand Down

0 comments on commit 23d3873

Please sign in to comment.