From fdc75cc43d908733f777fb571a14e8edbd6c2cc0 Mon Sep 17 00:00:00 2001
From: Alice BRENON <alice.brenon@ens-lyon.fr>
Date: Fri, 22 Dec 2023 14:25:03 +0100
Subject: [PATCH] Add FromJSON instances for ArticleRecord and @ types
---
lib/GEODE/Metadata/ArticleRecord.hs | 4 +++-
lib/GEODE/Metadata/Types.hs | 7 +++----
2 files changed, 6 insertions(+), 5 deletions(-)
diff --git a/lib/GEODE/Metadata/ArticleRecord.hs b/lib/GEODE/Metadata/ArticleRecord.hs
index fd589ff..23eac89 100644
--- a/lib/GEODE/Metadata/ArticleRecord.hs
+++ b/lib/GEODE/Metadata/ArticleRecord.hs
@@ -5,7 +5,7 @@ module GEODE.Metadata.ArticleRecord
, relativePath
, uid ) where
-import Data.Aeson ((.=), ToJSON(..))
+import Data.Aeson ((.=), FromJSON(..), ToJSON(..))
import Data.Aeson.KeyMap as KeyMap (fromList)
import Data.Csv (FromField(..), FromNamedRecord(..), ToNamedRecord(..), ToField(..))
import GEODE.Metadata.Record (Record(..))
@@ -34,6 +34,8 @@ instance ToJSONObject ArticleRecord where
<> "volume" .= volume
<> "article" .= article
+instance FromJSON ArticleRecord
+
instance Record ArticleRecord where
uid (ArticleRecord {work, volume, article}) =
printf "%s_%d_%d" (show $ work) volume article
diff --git a/lib/GEODE/Metadata/Types.hs b/lib/GEODE/Metadata/Types.hs
index 0a038b2..caeabec 100644
--- a/lib/GEODE/Metadata/Types.hs
+++ b/lib/GEODE/Metadata/Types.hs
@@ -4,7 +4,7 @@ module GEODE.Metadata.Types
, ToJSONObject(..)
, type (@)(..) ) where
-import Data.Aeson (Object, Series, ToJSON(..), Value(..), pairs)
+import Data.Aeson (FromJSON(..), Object, Series, ToJSON(..), Value(..), pairs)
import Data.Aeson.KeyMap as Object (union)
import Data.Csv (FromNamedRecord(..), ToNamedRecord(..))
import Data.HashMap.Strict as Hash (union)
@@ -39,6 +39,5 @@ instance {-# OVERLAPPABLE #-} ToJSONObject a => ToJSON a where
toJSON = Object . toJSONObject
toEncoding = pairs . toJSONPairs
-instance (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 #-} (FromJSON a, FromJSON b) => FromJSON (a @ b) where
+ parseJSON o = (:@:) <$> parseJSON o <*> parseJSON o
--
GitLab