summaryrefslogtreecommitdiff
path: root/Types
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2016-07-26 14:53:00 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2016-07-26 15:41:04 -0400
commit57b2c5d0eefa883bd77a846af41c30e108c6aa9b (patch)
treedb16c7911943d7f6f0151015b62ab988d9931ff7 /Types
parent6f8a19e034476e83cc2a52f661475ee54d8cabd6 (diff)
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.
Diffstat (limited to 'Types')
-rw-r--r--Types/MetaData.hs25
1 files changed, 25 insertions, 0 deletions
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