From 57b2c5d0eefa883bd77a846af41c30e108c6aa9b Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 26 Jul 2016 14:53:00 -0400
Subject: saner format for metadata --json

metadata --json output format has changed, adding a inner json object
named "fields" which contains only the fields and their values.

This should be easier to parse than the old format, which mixed up
metadata fields with other keys in the json object.

Any consumers of the old format will need to be updated.

This adds a dependency on unordered-containers for parsing MetaData
from JSON, but it's a free dependency; aeson pulls in that library.
---
 Types/MetaData.hs | 25 +++++++++++++++++++++++++
 1 file changed, 25 insertions(+)

(limited to 'Types')

diff --git a/Types/MetaData.hs b/Types/MetaData.hs
index 449548d53..a62dd7ed0 100644
--- a/Types/MetaData.hs
+++ b/Types/MetaData.hs
@@ -44,14 +44,32 @@ import Common
 import Utility.Base64
 import Utility.QuickCheck
 
+import qualified Data.Text as T
 import qualified Data.Set as S
 import qualified Data.Map as M
+import qualified Data.HashMap.Strict as HM
 import Data.Char
 import qualified Data.CaseInsensitive as CI
+import Data.Aeson
 
 newtype MetaData = MetaData (M.Map MetaField (S.Set MetaValue))
 	deriving (Show, Eq, Ord)
 
+instance ToJSON MetaData where
+	toJSON (MetaData m) = object $ map go (M.toList m)
+	  where
+		go (MetaField f, s) = (T.pack (CI.original f), toJSON s)
+
+instance FromJSON MetaData where
+	parseJSON (Object o) = do
+		l <- HM.toList <$> parseJSON (Object o)
+		MetaData . M.fromList <$> mapM go l
+	  where
+		go (t, l) = case mkMetaField (T.unpack t) of
+			Left e -> fail e
+			Right f -> (,) <$> pure f <*> parseJSON l
+	parseJSON _ = fail "expected an object"
+
 {- A metadata value can be currently be set (True), or may have been
  - set before and we're remembering it no longer is (False). -}
 newtype CurrentlySet = CurrentlySet Bool
@@ -64,6 +82,13 @@ newtype MetaField = MetaField (CI.CI String)
 data MetaValue = MetaValue CurrentlySet String
 	deriving (Read, Show)
 
+instance ToJSON MetaValue where
+	toJSON (MetaValue _ v) = toJSON v
+
+instance FromJSON MetaValue where
+	parseJSON (String v) = return $ MetaValue (CurrentlySet True) (T.unpack v)
+	parseJSON _  = fail "expected a string"
+
 {- Metadata values compare and order the same whether currently set or not. -}
 instance Eq MetaValue where
 	MetaValue _ a == MetaValue _ b = a == b
-- 
cgit v1.2.3