diff options
| -rw-r--r-- | Annex/MetaData.hs | 6 | ||||
| -rw-r--r-- | Annex/View.hs | 2 | ||||
| -rw-r--r-- | Command/View.hs | 4 | ||||
| -rw-r--r-- | Types/MetaData.hs | 31 | ||||
| -rw-r--r-- | debian/changelog | 1 | ||||
| -rw-r--r-- | doc/design/metadata.mdwn | 9 | ||||
| -rw-r--r-- | doc/install/fromscratch.mdwn | 2 | ||||
| -rw-r--r-- | doc/metadata.mdwn | 6 | ||||
| -rw-r--r-- | git-annex.cabal | 4 |
9 files changed, 33 insertions, 32 deletions
diff --git a/Annex/MetaData.hs b/Annex/MetaData.hs index b7850a868..68aef33f1 100644 --- a/Annex/MetaData.hs +++ b/Annex/MetaData.hs @@ -20,13 +20,13 @@ import Data.Time.Clock import Data.Time.Clock.POSIX tagMetaField :: MetaField -tagMetaField = MetaField "tag" +tagMetaField = mkMetaFieldUnchecked "tag" yearMetaField :: MetaField -yearMetaField = MetaField "year" +yearMetaField = mkMetaFieldUnchecked "year" monthMetaField :: MetaField -monthMetaField = MetaField "month" +monthMetaField = mkMetaFieldUnchecked "month" {- Adds metadata for a file that has just been ingested into the - annex, but has not yet been committed to git. diff --git a/Annex/View.hs b/Annex/View.hs index 9d1a763e2..254cd7274 100644 --- a/Annex/View.hs +++ b/Annex/View.hs @@ -249,7 +249,7 @@ getDirMetaData :: FilePath -> MetaData getDirMetaData d = MetaData $ M.fromList $ zip fields values where dirs = splitDirectories d - fields = map (MetaField . addTrailingPathSeparator . joinPath) + fields = map (mkMetaFieldUnchecked . addTrailingPathSeparator . joinPath) (inits dirs) values = map (S.singleton . toMetaValue . fromMaybe "" . headMaybe) (tails dirs) diff --git a/Command/View.hs b/Command/View.hs index e5182e852..932bc2d00 100644 --- a/Command/View.hs +++ b/Command/View.hs @@ -49,14 +49,14 @@ paramView = paramPair (paramRepeating "TAG") (paramRepeating "FIELD=VALUE") {- Parse field=value - - Note that the field may not be a legal metadata field name, - - but it's let through anywa (using MetaField rather than mkMetaField). + - but it's let through anyway. - This is useful when matching on directory names with spaces, - which are not legal MetaFields. -} parseViewParam :: String -> (MetaField, String) parseViewParam s = case separate (== '=') s of (tag, []) -> (tagMetaField, tag) - (field, wanted) -> (MetaField field, wanted) + (field, wanted) -> (mkMetaFieldUnchecked field, wanted) mkView :: [String] -> Annex View mkView params = do 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 diff --git a/debian/changelog b/debian/changelog index e0dac361f..6b9c0d3a9 100644 --- a/debian/changelog +++ b/debian/changelog @@ -2,6 +2,7 @@ git-annex (5.20140222) UNRELEASED; urgency=medium * metadata: Field names limited to alphanumerics and a few whitelisted punctuation characters to avoid issues with views, etc. + * metadata: FIeld names are now case insensative. * When constructing views, metadata is available about the location of the file in the view's reference branch. Allows incorporating parts of the directory hierarchy in a view. diff --git a/doc/design/metadata.mdwn b/doc/design/metadata.mdwn index 7d1ff4bfa..704738843 100644 --- a/doc/design/metadata.mdwn +++ b/doc/design/metadata.mdwn @@ -180,14 +180,7 @@ So, possible approaches: 2 directories representing a metadata field. Solution might be to compare fields names case-insensitively, and - pick one representation consistently. - - Alternatively, it could escape `A` to `_A` when such a filesystem - is detected and avoid collisions that way (double `_` to escape it). - This latter option is ugly, but so are non-posix filesystems.. and it - also solves any similar issues with case-colliding filenames. - - TODO: Check current state of this. + pick one representation consistently. **done** * Assistant needs to know about views, so it can update metadata when files are moved around inside them. TODO diff --git a/doc/install/fromscratch.mdwn b/doc/install/fromscratch.mdwn index 6cc2d90c6..210b6ed7f 100644 --- a/doc/install/fromscratch.mdwn +++ b/doc/install/fromscratch.mdwn @@ -26,6 +26,7 @@ quite a lot. * [extensible-exceptions](http://hackage.haskell.org/package/extensible-exceptions) * [feed](http://hackage.haskell.org/package/feed) * [async](http://hackage.haskell.org/package/async) + * [case-insensitive](http://hackage.haskell.org/package/case-insensitive) * [stm](http://hackage.haskell.org/package/stm) (version 2.3 or newer) * Optional haskell stuff, used by the [[assistant]] and its webapp @@ -36,7 +37,6 @@ quite a lot. * [yesod-static](http://hackage.haskell.org/package/yesod-static) * [yesod-default](http://hackage.haskell.org/package/yesod-default) * [data-default](http://hackage.haskell.org/package/data-default) - * [case-insensitive](http://hackage.haskell.org/package/case-insensitive) * [http-types](http://hackage.haskell.org/package/http-types) * [wai](http://hackage.haskell.org/package/wai) * [wai-logger](http://hackage.haskell.org/package/wai-logger) diff --git a/doc/metadata.mdwn b/doc/metadata.mdwn index d3c3b748e..9966e7d7d 100644 --- a/doc/metadata.mdwn +++ b/doc/metadata.mdwn @@ -19,9 +19,9 @@ fields, which each can have any number of values. For example, to tag files, the `tag` field is typically used, with values set to each tag that applies to the file. -The field names are limited to alphanumerics (and `[_-.]`). The metadata -values can contain absolutely anything you like -- but you're recommended -to keep it simple and reasonably short. +The field names are limited to alphanumerics (and `[_-.]`), and are case +insensitive. The metadata values can contain absolutely anything you +like -- but you're recommended to keep it simple and reasonably short. Here are some recommended metadata fields to use: diff --git a/git-annex.cabal b/git-annex.cabal index d7bf6cad6..3189a8ab4 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -94,7 +94,7 @@ Executable git-annex base (>= 4.5 && < 4.9), monad-control, MonadCatchIO-transformers, IfElse, text, QuickCheck >= 2.1, bloomfilter, edit-distance, process, SafeSemaphore, uuid, random, dlist, unix-compat, async, stm (>= 2.3), - data-default + data-default, case-insensitive CC-Options: -Wall GHC-Options: -Wall Extensions: PackageImports @@ -174,7 +174,7 @@ Executable git-annex if flag(Webapp) Build-Depends: yesod, yesod-default, yesod-static, yesod-form, yesod-core, - case-insensitive, http-types, transformers, wai, wai-logger, warp, + http-types, transformers, wai, wai-logger, warp, blaze-builder, crypto-api, hamlet, clientsession, template-haskell, data-default, aeson, network-conduit CPP-Options: -DWITH_WEBAPP |