lib/GEODE/Metadata/ArticleRecord.hs

@@ -5,11 +5,11 @@ 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 Data.Csv (FromNamedRecord(..), ToNamedRecord(..))
 import GEODE.Metadata.Record (Record(..))
-import GEODE.Metadata.Types (Has(..), ToJSONObject(..))
+import GEODE.Metadata.Types (ToJSONObject(..))
 import GEODE.Metadata.TSV.Header (DefaultFields(..), HasDefaultHeader(..))
 import GEODE.Metadata.Work (Work(..))
 import GHC.Generics (Generic)
@@ -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
@@ -41,13 +43,5 @@ instance Record ArticleRecord where
   relativePath (ArticleRecord {work, volume, article}) extension =
     (show work) </> ("T" <> show volume) </> (show article) <.> extension
 
-{-
-relativePath :: Has ArticleRecord a => a -> String -> FilePath
-relativePath a extension =
-  (show work) </> ("T" <> show volume) </> (show article) <.> extension
-  where
-    ArticleRecord {work, volume, article} = get a
--}
-
 instance HasDefaultHeader ArticleRecord where
   defaultFields = DefaultFields [ "work", "volume", "article" ]

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)
@@ -35,10 +35,10 @@ class ToJSONObject a where
   toJSONObject :: a -> Object
   toJSONPairs :: a -> Series
 
-instance {-# OVERLAPPABLE #-} ToJSONObject a => ToJSON a where
-  toJSON = Object . toJSONObject
-  toEncoding = pairs . toJSONPairs
+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
 
-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