diff options
-rw-r--r-- | Annex/View.hs | 88 | ||||
-rw-r--r-- | Annex/View/ViewedFile.hs | 75 | ||||
-rw-r--r-- | Command/PreCommit.hs | 5 | ||||
-rw-r--r-- | Command/VAdd.hs | 6 | ||||
-rw-r--r-- | Command/View.hs | 11 | ||||
-rw-r--r-- | Test.hs | 2 | ||||
-rw-r--r-- | Types/View.hs | 4 | ||||
-rw-r--r-- | debian/changelog | 5 | ||||
-rw-r--r-- | doc/design/metadata.mdwn | 9 | ||||
-rw-r--r-- | doc/git-annex.mdwn | 26 | ||||
-rw-r--r-- | doc/tips/metadata_driven_views.mdwn | 33 |
11 files changed, 190 insertions, 74 deletions
diff --git a/Annex/View.hs b/Annex/View.hs index fe32fdaa3..ece5d099e 100644 --- a/Annex/View.hs +++ b/Annex/View.hs @@ -8,6 +8,7 @@ module Annex.View where import Common.Annex +import Annex.View.ViewedFile import Types.View import Types.MetaData import qualified Git @@ -33,6 +34,7 @@ import Config import CmdLine.Action import qualified Data.Set as S +import qualified Data.Map as M import "mtl" Control.Monad.Writer {- Each visible ViewFilter in a view results in another level of @@ -125,35 +127,6 @@ combineViewFilter (FilterGlob old) newglob@(FilterGlob new) | matchGlob (compileGlob old CaseInsensative) new = (newglob, Narrowing) | otherwise = (newglob, Widening) -{- Converts a filepath used in a reference branch to the - - filename that will be used in the view. - - - - No two filepaths from the same branch should yeild the same result, - - so all directory structure needs to be included in the output file - - in some way. However, the branch's directory structure is not relevant - - in the view. - - - - So, from dir/subdir/file.foo, generate file_{dir;subdir}.foo - - - - (To avoid collisions with a filename that already contains {foo}, - - that is doubled to {{foo}}.) - -} -fileViewFromReference :: MkFileView -fileViewFromReference f = concat - [ double base - , if null dirs then "" else "_{" ++ double (intercalate ";" dirs) ++ "}" - , double $ concat extensions - ] - where - (path, basefile) = splitFileName f - dirs = filter (/= ".") $ map dropTrailingPathSeparator (splitPath path) - (base, extensions) = splitShortExtensions basefile - - double = replace "{" "{{" . replace "}" "}}" - -fileViewReuse :: MkFileView -fileViewReuse = takeFileName - {- Generates views for a file from a branch, based on its metadata - and the filename used in the branch. - @@ -167,10 +140,10 @@ fileViewReuse = takeFileName - evaluate this function with the view parameter and reuse - the result. The globs in the view will then be compiled and memoized. -} -fileViews :: View -> MkFileView -> FilePath -> MetaData -> [FileView] -fileViews view = +viewedFiles :: View -> MkViewedFile -> FilePath -> MetaData -> [ViewedFile] +viewedFiles view = let matchers = map viewComponentMatcher (viewComponents view) - in \mkfileview file metadata -> + in \mkviewedfile file metadata -> let matches = map (\m -> m metadata) matchers in if any isNothing matches then [] @@ -178,8 +151,8 @@ fileViews view = let paths = pathProduct $ map (map toViewPath) (visible matches) in if null paths - then [mkfileview file] - else map (</> mkfileview file) paths + then [mkviewedfile file] + else map (</> mkviewedfile file) paths where visible = map (fromJust . snd) . filter (viewVisible . fst) . @@ -237,9 +210,9 @@ pathProduct (l:ls) = foldl combinel l ls where combinel xs ys = [combine x y | x <- xs, y <- ys] -{- Extracts the metadata from a fileview, based on the view that was used +{- Extracts the metadata from a ViewedFile, based on the view that was used - to construct it. -} -fromView :: View -> FileView -> MetaData +fromView :: View -> ViewedFile -> MetaData fromView view f = foldr (uncurry updateMetaData) newMetaData (zip fields values) where visible = filter viewVisible (viewComponents view) @@ -248,12 +221,12 @@ fromView view f = foldr (uncurry updateMetaData) newMetaData (zip fields values) values = map fromViewPath paths {- Constructing a view that will match arbitrary metadata, and applying - - it to a file yields a set of FileViews which all contain the same + - it to a file yields a set of ViewedFile which all contain the same - MetaFields that were present in the input metadata - (excluding fields that are not visible). -} prop_view_roundtrips :: FilePath -> MetaData -> Bool -> Bool prop_view_roundtrips f metadata visible = null f || viewTooLarge view || - all hasfields (fileViews view fileViewFromReference f metadata) + all hasfields (viewedFiles view viewedFileFromReference f metadata) where view = View (Git.Ref "master") $ map (\(mf, mv) -> ViewComponent mf (FilterValues $ S.filter (not . null . fromMetaValue) mv) visible) @@ -261,11 +234,32 @@ prop_view_roundtrips f metadata visible = null f || viewTooLarge view || visiblefields = sort (map viewField $ filter viewVisible (viewComponents view)) hasfields fv = sort (map fst (fromMetaData (fromView view fv))) == visiblefields +{- A directory foo/bar/baz/ is turned into metadata fields + - /=foo, foo/=bar, foo/bar/=baz. + - + - Note that this may generate MetaFields that legalField rejects. + - This is necessary to have a 1:1 mapping between directory names and + - fields. So this MetaData cannot safely be serialized. -} +getDirMetaData :: FilePath -> MetaData +getDirMetaData d = MetaData $ M.fromList $ zip fields values + where + dirs = splitDirectories d + fields = map (MetaField . addTrailingPathSeparator . joinPath) + (inits dirs) + values = map (S.singleton . toMetaValue . fromMaybe "" . headMaybe) + (tails dirs) + +getWorkTreeMetaData :: FilePath -> MetaData +getWorkTreeMetaData = getDirMetaData . dropFileName + +getViewedFileMetaData :: FilePath -> MetaData +getViewedFileMetaData = getDirMetaData . dirFromViewedFile . takeFileName + {- Applies a view to the currently checked out branch, generating a new - branch for the view. -} applyView :: View -> Annex Git.Branch -applyView view = applyView' fileViewFromReference view +applyView view = applyView' viewedFileFromReference getWorkTreeMetaData view {- Generates a new branch for a View, which must be a more narrow - version of the View originally used to generate the currently @@ -273,18 +267,18 @@ applyView view = applyView' fileViewFromReference view - in view, not any others. -} narrowView :: View -> Annex Git.Branch -narrowView = applyView' fileViewReuse +narrowView = applyView' viewedFileReuse getViewedFileMetaData {- Go through each file in the currently checked out branch. - If the file is not annexed, skip it, unless it's a dotfile in the top. - - Look up the metadata of annexed files, and generate any FileViews, + - Look up the metadata of annexed files, and generate any ViewedFiles, - and stage them. - - Currently only works in indirect mode. Must be run from top of - repository. -} -applyView' :: MkFileView -> View -> Annex Git.Branch -applyView' mkfileview view = do +applyView' :: MkViewedFile -> (FilePath -> MetaData) -> View -> Annex Git.Branch +applyView' mkviewedfile getfilemetadata view = do top <- fromRepo Git.repoPath (l, clean) <- inRepo $ Git.LsFiles.inRepo [top] liftIO . nukeFile =<< fromRepo gitAnnexViewIndex @@ -298,10 +292,12 @@ applyView' mkfileview view = do void $ stopUpdateIndex uh void clean where - genfileviews = fileViews view mkfileview -- enables memoization + genviewedfiles = viewedFiles view mkviewedfile -- enables memoization go uh hasher f (Just (k, _)) = do metadata <- getCurrentMetaData k - forM_ (genfileviews f metadata) $ \fv -> do + let dirmetadata = getfilemetadata f + let metadata' = unionMetaData dirmetadata metadata + forM_ (genviewedfiles f metadata') $ \fv -> do stagesymlink uh hasher fv =<< inRepo (gitAnnexLink fv k) go uh hasher f Nothing | "." `isPrefixOf` f = do @@ -350,7 +346,7 @@ updateView view ref oldref = genViewBranch view $ do - Note that removes must be handled before adds. This is so - that moving a file from x/foo/ to x/bar/ adds back the metadata for x. -} -withViewChanges :: (FileView -> Key -> CommandStart) -> (FileView -> Key -> CommandStart) -> Annex () +withViewChanges :: (ViewedFile -> Key -> CommandStart) -> (ViewedFile -> Key -> CommandStart) -> Annex () withViewChanges addmeta removemeta = do makeabs <- flip fromTopFilePath <$> gitRepo (diffs, cleanup) <- inRepo $ DiffTree.diffIndex Git.Ref.headRef diff --git a/Annex/View/ViewedFile.hs b/Annex/View/ViewedFile.hs new file mode 100644 index 000000000..5733d4c94 --- /dev/null +++ b/Annex/View/ViewedFile.hs @@ -0,0 +1,75 @@ +{- filenames (not paths) used in views + - + - Copyright 2014 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Annex.View.ViewedFile ( + ViewedFile, + MkViewedFile, + viewedFileFromReference, + viewedFileReuse, + dirFromViewedFile, + prop_viewedFile_roundtrips, +) where + +import Common.Annex + +type FileName = String +type ViewedFile = FileName + +type MkViewedFile = FilePath -> ViewedFile + +{- Converts a filepath used in a reference branch to the + - filename that will be used in the view. + - + - No two filepaths from the same branch should yeild the same result, + - so all directory structure needs to be included in the output filename + - in some way. + - + - So, from dir/subdir/file.foo, generate file_%dir%subdir%.foo + -} +viewedFileFromReference :: MkViewedFile +viewedFileFromReference f = concat + [ escape base + , if null dirs then "" else "_%" ++ intercalate "%" (map escape dirs) ++ "%" + , escape $ concat extensions + ] + where + (path, basefile) = splitFileName f + dirs = filter (/= ".") $ map dropTrailingPathSeparator (splitPath path) + (base, extensions) = splitShortExtensions basefile + + {- To avoid collisions with filenames or directories that contain + - '%', and to allow the original directories to be extracted + - from the ViewedFile, '%' is escaped to '\%' (and '\' to '\\'). + -} + escape :: String -> String + escape = replace "%" "\\%" . replace "\\" "\\\\" + +{- For use when operating already within a view, so whatever filepath + - is present in the work tree is already a ViewedFile. -} +viewedFileReuse :: MkViewedFile +viewedFileReuse = takeFileName + +{- Extracts from a ViewedFile the directory where the file is located on + - in the reference branch. -} +dirFromViewedFile :: ViewedFile -> FilePath +dirFromViewedFile = joinPath . drop 1 . sep [] "" + where + sep l _ [] = reverse l + sep l curr (c:cs) + | c == '%' = sep (reverse curr:l) "" cs + | c == '\\' = case cs of + (c':cs') -> sep l (c':curr) cs' + [] -> sep l curr cs + | otherwise = sep l (c:curr) cs + +prop_viewedFile_roundtrips :: FilePath -> Bool +prop_viewedFile_roundtrips f + | isAbsolute f = True -- Only relative paths are encoded. + | any (isPathSeparator) (end f) = True -- Filenames wanted, not directories. + | otherwise = dir == dirFromViewedFile (viewedFileFromReference f) + where + dir = joinPath $ beginning $ splitDirectories f diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs index 4b90b5c2e..07d958de1 100644 --- a/Command/PreCommit.hs +++ b/Command/PreCommit.hs @@ -14,6 +14,7 @@ import qualified Command.Add import qualified Command.Fix import Annex.Direct import Annex.View +import Annex.View.ViewedFile import Logs.View import Logs.MetaData import Types.View @@ -52,12 +53,12 @@ startIndirect f = next $ do startDirect :: [String] -> CommandStart startDirect _ = next $ next $ preCommitDirect -addViewMetaData :: View -> FileView -> Key -> CommandStart +addViewMetaData :: View -> ViewedFile -> Key -> CommandStart addViewMetaData v f k = do showStart "metadata" f next $ next $ changeMetaData k $ fromView v f -removeViewMetaData :: View -> FileView -> Key -> CommandStart +removeViewMetaData :: View -> ViewedFile -> Key -> CommandStart removeViewMetaData v f k = do showStart "metadata" f next $ next $ changeMetaData k $ unsetMetaData $ fromView v f diff --git a/Command/VAdd.hs b/Command/VAdd.hs index 3dc1fd4cf..6b53aa7ea 100644 --- a/Command/VAdd.hs +++ b/Command/VAdd.hs @@ -10,11 +10,11 @@ module Command.VAdd where import Common.Annex import Command import Annex.View -import Command.View (paramView, parseViewParam, checkoutViewBranch) +import Command.View (parseViewParam, checkoutViewBranch) def :: [Command] -def = [notBareRepo $ notDirect $ - command "vadd" paramView seek SectionMetaData "add subdirs to current view"] +def = [notBareRepo $ notDirect $ command "vadd" (paramRepeating "FIELD=GLOB") + seek SectionMetaData "add subdirs to current view"] seek :: CommandSeek seek = withWords start diff --git a/Command/View.hs b/Command/View.hs index 17e136f7b..f123e3812 100644 --- a/Command/View.hs +++ b/Command/View.hs @@ -43,12 +43,19 @@ perform view = do next $ checkoutViewBranch view applyView paramView :: String -paramView = paramPair (paramRepeating "FIELD=VALUE") (paramRepeating "TAG") +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). + - 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) -> either error (\f -> (f, wanted)) (mkMetaField field) + (field, wanted) -> (MetaField field, wanted) mkView :: [String] -> Annex View mkView params = do @@ -55,6 +55,7 @@ import qualified Crypto import qualified Annex.Init import qualified Annex.CatFile import qualified Annex.View +import qualified Annex.View.ViewedFile import qualified Logs.View import qualified Utility.Path import qualified Utility.FileMode @@ -151,6 +152,7 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck" , testProperty "prop_metadata_serialize" Types.MetaData.prop_metadata_serialize , testProperty "prop_branchView_legal" Logs.View.prop_branchView_legal , testProperty "prop_view_roundtrips" Annex.View.prop_view_roundtrips + , testProperty "prop_viewedFile_rountrips" Annex.View.ViewedFile.prop_viewedFile_roundtrips ] {- These tests set up the test environment, but also test some basic parts diff --git a/Types/View.hs b/Types/View.hs index 04b002879..618193cf9 100644 --- a/Types/View.hs +++ b/Types/View.hs @@ -35,10 +35,6 @@ data ViewComponent = ViewComponent instance Arbitrary ViewComponent where arbitrary = ViewComponent <$> arbitrary <*> arbitrary <*> arbitrary -{- Only files with metadata matching the view are displayed. -} -type FileView = FilePath -type MkFileView = FilePath -> FileView - data ViewFilter = FilterValues (S.Set MetaValue) | FilterGlob String diff --git a/debian/changelog b/debian/changelog index 37193891a..4d5589ed0 100644 --- a/debian/changelog +++ b/debian/changelog @@ -4,6 +4,11 @@ git-annex (5.20140222) UNRELEASED; urgency=medium including rsync.net. * --metadata field=value can now use globs to match, and matches case insensatively, the same as git annex view field=value does. + * 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. + For example `git annex view tag=* podcasts/=*` makes a view in the form + tag/showname. -- Joey Hess <joeyh@debian.org> Fri, 21 Feb 2014 13:03:04 -0400 diff --git a/doc/design/metadata.mdwn b/doc/design/metadata.mdwn index db0d51c5c..c700e3674 100644 --- a/doc/design/metadata.mdwn +++ b/doc/design/metadata.mdwn @@ -70,7 +70,7 @@ metadata is derived, at least year=yyyy and probably also month, etc. ### directory hierarchy metadata -TODO From the original filename used in the master branch, when +From the original filename used in the master branch, when constructing a view, generate fields. For example foo/bar/baz.mp3 would get /=foo, foo/=bar, foo/bar/=baz, and .=mp3. @@ -82,11 +82,12 @@ This allows using whatever directory hierarchy exists to inform the view, without locking the view into using it. Complication: When refining a view, it only looks at the filenames in -the view, so it would need to map from +the view, so it has to map from those filenames to derive the same metadata, unless there is persistent storage. Luckily, the filenames used in the views currently include the -subdirs (although not quite in a parseable format, would need some small -changes). +subdirs. + +**done**! # other uses for metadata diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 97f2b2918..3c233f378 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -715,20 +715,29 @@ subdirectories). git annex metadata annexscreencast.ogv -t video -t screencast -s author+=Alice -* `view [field=value ...] [tag ...]` +* `view [tag ...] [field=value ...] [location/=value]` Uses metadata to build a view branch of the files in the current branch, and checks out the view branch. Only files in the current branch whose metadata matches all the specified field values and tags will be shown in the view. + + Once within a view, you can make additional directories, and + copy or move files into them. When you commit, the metadata will + be updated to correspond to your changes. Multiple values for a metadata field can be specified, either by using a glob (`field="*"`) or by listing each wanted value. The resulting view will put files in subdirectories according to the value of their fields. - Once within a view, you can make additional directories, and - copy or move files into them. When you commit, the metadata will - be updated to correspond to your changes. + There are fields corresponding to the path to the file. So a file + "foo/bar/baz/file" has fields "/=foo", "foo/=bar", and "foo/bar/=baz". + These location fields can be used the same as other metadata to construct + the view. + + For example, `/=podcasts` will only include files from the podcasts + directory in the view, while `podcasts/=*` will preserve the + subdirectories of the podcasts directory in the view. * `vpop [N]` @@ -737,12 +746,12 @@ subdirectories). The optional number tells how many views to pop. -* `vfilter [field=value ...] [tag ...]` +* `vfilter [tag ...] [field=value ...] [location/=value]` Filters the current view to only the files that have the - specified values and tags. + specified field values, tags, and locations. -* `vadd [field=glob ...]` +* `vadd [field=glob ...] [location/=glob]` Changes the current view, adding an additional level of directories to categorize the files. @@ -1136,7 +1145,8 @@ file contents are present at either of two repositories. * `--metadata field=glob` Matches only files that have a metadata field attached with a value that - matches the glob. + matches the glob. The values of metadata fields are matched case + insensitively. * `--want-get` diff --git a/doc/tips/metadata_driven_views.mdwn b/doc/tips/metadata_driven_views.mdwn index 7b46ca974..e24bf29ae 100644 --- a/doc/tips/metadata_driven_views.mdwn +++ b/doc/tips/metadata_driven_views.mdwn @@ -24,8 +24,8 @@ metadata: # git annex metadata --tag done videos/old # git annex metadata --tag new videos/lotsofcats.ogv # git annex metadata --tag sound podcasts - # git annex metadata --tag done podcasts/old - # git annex metadata --tag new podcasts/recent + # git annex metadata --tag done podcasts/*/old + # git annex metadata --tag new podcasts/*/recent So, you had a bunch of different kinds of files sorted into a directory structure. But that didn't really reflect how you approach the files. @@ -81,9 +81,11 @@ all the way out of all views, you'll be back on the regular git branch you originally started from. You can also use `git checkout` to switch between views and other branches. -Beyond simple tags, you can add whatever kinds of metadata you like, and -use that metadata in more elaborate views. For example, let's add a year -field. +## fields + +Beyond simple tags and directories, you can add whatever kinds of metadata +you like, and use that metadata in more elaborate views. For example, let's +add a year field. # git checkout master # git annex metadata --set year=2014 work/2014 @@ -118,4 +120,25 @@ Oh, did you want it the other way around? Easy! |-- 2014 `-- 2013 +## location fields + +Let's switch to a view containing only new podcasts. And since the +podcasts are organized into one subdirectory per show, let's +include those subdirectories in the view. + + # git checkout master + # git annex view tag=new podcasts/=* + # tree -d + This_Developers_Life + Escape_Pod + GitMinutes + The_Haskell_Cast + StarShipSofa + +That's an example of using part of the directory layout of the original +branch to inform the view. Every file gets fields automatically set up +corresponding to the directory it's in. So a file"foo/bar/baz/file" has +fields "/=foo", "foo/=bar", and "foo/bar/=baz". These location fields +can be used the same as other metadata to construct the view. + This has probably only scratched the surface of what you can do with views. |