diff options
| author |  Joey Hess <joey@kitenet.net> | 2014-02-25 18:45:09 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2014-02-25 18:45:09 -0400 |
| commit | 425b6fca0046d6fb8ddd8a8a4f2bd77fef52c25d (patch) | |
| tree | eec260145fb8df2a8160e6dc3b248751878e381d /Types/MetaData.hs | |
| parent | 7b15c2146cb3fcb60a95dd6df435b34bd97e39db (diff) | |
metadata: FIeld names are now case insensative.
Diffstat (limited to 'Types/MetaData.hs')
| -rw-r--r-- | Types/MetaData.hs | 31 |
1 files changed, 19 insertions, 12 deletions
diff --git a/Types/MetaData.hs b/Types/MetaData.hs index 7c4028a2d..6f8a300b2 100644 --- a/Types/MetaData.hs +++ b/Types/MetaData.hs @@ -17,6 +17,7 @@ module Types.MetaData ( MetaSerializable, toMetaField, mkMetaField, + mkMetaFieldUnchecked, fromMetaField, toMetaValue, mkMetaValue, @@ -47,6 +48,7 @@ import Utility.QuickCheck import qualified Data.Set as S import qualified Data.Map as M import Data.Char +import qualified Data.CaseInsensitive as CI newtype MetaData = MetaData (M.Map MetaField (S.Set MetaValue)) deriving (Show, Eq, Ord) @@ -56,7 +58,8 @@ newtype MetaData = MetaData (M.Map MetaField (S.Set MetaValue)) newtype CurrentlySet = CurrentlySet Bool deriving (Read, Show, Eq, Ord, Arbitrary) -newtype MetaField = MetaField String +{- Fields are case insensitive. -} +newtype MetaField = MetaField (CI.CI String) deriving (Read, Show, Eq, Ord) data MetaValue = MetaValue CurrentlySet String @@ -90,8 +93,8 @@ instance MetaSerializable MetaData where Nothing -> getfield m l instance MetaSerializable MetaField where - serialize (MetaField f) = f - deserialize = Just . MetaField + serialize (MetaField f) = CI.original f + deserialize = Just . mkMetaFieldUnchecked {- Base64 problimatic values. -} instance MetaSerializable MetaValue where @@ -115,9 +118,19 @@ instance MetaSerializable CurrentlySet where deserialize "-" = Just (CurrentlySet False) deserialize _ = Nothing +mkMetaField :: String -> Either String MetaField +mkMetaField f = maybe (Left $ badField f) Right (toMetaField f) + +badField :: String -> String +badField f = "Illegal metadata field name, \"" ++ f ++ "\"" + +{- Does not check that the field name is valid. Use with caution. -} +mkMetaFieldUnchecked :: String -> MetaField +mkMetaFieldUnchecked = MetaField . CI.mk + toMetaField :: String -> Maybe MetaField toMetaField f - | legalField f = Just $ MetaField f + | legalField f = Just $ MetaField $ CI.mk f | otherwise = Nothing {- Fields cannot be empty, contain whitespace, or start with "+-" as @@ -153,7 +166,7 @@ unsetMetaData :: MetaData -> MetaData unsetMetaData (MetaData m) = MetaData $ M.map (S.map unsetMetaValue) m fromMetaField :: MetaField -> String -fromMetaField (MetaField f) = f +fromMetaField (MetaField f) = CI.original f fromMetaValue :: MetaValue -> String fromMetaValue (MetaValue _ f) = f @@ -236,12 +249,6 @@ parseMetaData p = (,) where (f, v) = separate (== '=') p -mkMetaField :: String -> Either String MetaField -mkMetaField f = maybe (Left $ badField f) Right (toMetaField f) - -badField :: String -> String -badField f = "Illegal metadata field name, \"" ++ f ++ "\"" - {- Avoid putting too many fields in the map; extremely large maps make - the seriaization test slow due to the sheer amount of data. - It's unlikely that more than 100 fields of metadata will be used. -} @@ -254,7 +261,7 @@ instance Arbitrary MetaValue where arbitrary = MetaValue <$> arbitrary <*> arbitrary instance Arbitrary MetaField where - arbitrary = MetaField <$> arbitrary `suchThat` legalField + arbitrary = MetaField . CI.mk <$> arbitrary `suchThat` legalField prop_metadata_sane :: MetaData -> MetaField -> MetaValue -> Bool prop_metadata_sane m f v = and |