From 60eb2c025590bd4687778c70a8559081f7eed9e8 Mon Sep 17 00:00:00 2001
From: Alice BRENON <alice.brenon@ens-lyon.fr>
Date: Sat, 24 Feb 2024 22:13:39 +0100
Subject: [PATCH] Keep the best of both worlds, go ToJSONObject -> ToJSON as
soon as a :@: is formed, but forward the ToJSONObject instance too (so that
future :@:-extensions can be made and magically get the ToJSON instance while
propagating the ToJSONObject instance)
---
lib/GEODE/Metadata/Types.hs | 9 +++++++--
1 file changed, 7 insertions(+), 2 deletions(-)
diff --git a/lib/GEODE/Metadata/Types.hs b/lib/GEODE/Metadata/Types.hs
index 9e7e6f8..c2a81e5 100644
--- a/lib/GEODE/Metadata/Types.hs
+++ b/lib/GEODE/Metadata/Types.hs
@@ -44,10 +44,15 @@ class ToJSONObject a where
toJSONObject :: a -> Object
toJSONPairs :: a -> Series
+instance {-# OVERLAPPABLE #-} (ToJSONObject a, ToJSONObject b) =>
+ ToJSONObject (a @ b) where
+ toJSONObject (a :@: b) = toJSONObject a `Object.union` toJSONObject b
+ toJSONPairs (a :@: b) = toJSONPairs a <> toJSONPairs b
+
instance {-# OVERLAPPABLE #-} (ToJSONObject a, ToJSONObject b) =>
ToJSON (a @ b) where
- toJSON (a :@: b) = Object $ toJSONObject a `Object.union` toJSONObject b
- toEncoding (a :@: b) = pairs $ toJSONPairs a <> toJSONPairs b
+ toJSON = Object . toJSONObject
+ toEncoding = pairs . toJSONPairs
instance {-# OVERLAPPABLE #-} (FromJSON a, FromJSON b) => FromJSON (a @ b) where
parseJSON o = (:@:) <$> parseJSON o <*> parseJSON o
--
GitLab