From b7650a2ad9c19264cfeee3449a3270dde98eafb5 Mon Sep 17 00:00:00 2001
From: Alice BRENON <alice.brenon@ens-lyon.fr>
Date: Tue, 26 Sep 2023 13:29:42 +0200
Subject: [PATCH] Implement JSON conversion for Work type
---
lib/GEODE/Metadata/Work.hs | 31 ++++++++++++++++++-------------
1 file changed, 18 insertions(+), 13 deletions(-)
diff --git a/lib/GEODE/Metadata/Work.hs b/lib/GEODE/Metadata/Work.hs
index 9c0aa93..68e4117 100644
--- a/lib/GEODE/Metadata/Work.hs
+++ b/lib/GEODE/Metadata/Work.hs
@@ -1,25 +1,30 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DeriveGeneric, OverloadedStrings #-}
module GEODE.Metadata.Work
( Work(..) ) where
-import Data.Aeson (ToJSON(..))
+import Data.Aeson (FromJSON(..), ToJSON(..), withText)
+import Data.ByteString.Char8 as ByteString (unpack)
import Data.Csv (FromField(..), ToField(..))
import Data.Char (toLower)
-import Data.ByteString.Char8 as ByteString (map)
+import Data.Text as Text (unpack)
+import GHC.Generics (Generic)
-data Work = EDdA | LGE | Wikipedia deriving (Eq, Ord, Read, Show)
+data Work = EDdA | LGE | Wikipedia deriving (Eq, Generic, Ord, Show)
+
+tolerantParser :: (Applicative m, Monoid (m Work)) => String -> m Work
+tolerantParser = recognize . fmap toLower
+ where
+ recognize "edda" = pure EDdA
+ recognize "lge" = pure LGE
+ recognize "wikipedia" = pure Wikipedia
+ recognize _ = mempty
instance FromField Work where
- parseField = recognize . ByteString.map toLower
- where
- recognize "EDdA" = pure EDdA
- recognize "LGE" = pure LGE
- recognize "Wikipedia" = pure Wikipedia
- recognize _ = mempty
+ parseField = tolerantParser . ByteString.unpack
instance ToField Work where
toField = toField . show
-instance ToJSON Work where
- toJSON = toJSON . show
-
+instance ToJSON Work
+instance FromJSON Work where
+ parseJSON = withText "Work" $ tolerantParser . Text.unpack
--
GitLab