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.
This commit is contained in:
parent
5c92b8e034
commit
8bc8469c38
6 changed files with 80 additions and 6 deletions
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue