diff options
| -rw-r--r-- | Annex/View.hs | 64 | ||||
| -rw-r--r-- | Annex/View/ViewedFile.hs | 67 | ||||
| -rw-r--r-- | Command/PreCommit.hs | 5 | ||||
| -rw-r--r-- | Types/View.hs | 4 |
4 files changed, 88 insertions, 52 deletions
diff --git a/Annex/View.hs b/Annex/View.hs index fe32fdaa3..0985e930f 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 @@ -125,35 +126,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 +139,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 +150,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 +209,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 +220,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) @@ -265,7 +237,7 @@ prop_view_roundtrips f metadata visible = null f || viewTooLarge view || - branch for the view. -} applyView :: View -> Annex Git.Branch -applyView view = applyView' fileViewFromReference view +applyView view = applyView' viewedFileFromReference 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 +245,18 @@ applyView view = applyView' fileViewFromReference view - in view, not any others. -} narrowView :: View -> Annex Git.Branch -narrowView = applyView' fileViewReuse +narrowView = applyView' viewedFileReuse {- 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 -> View -> Annex Git.Branch +applyView' mkviewedfile view = do top <- fromRepo Git.repoPath (l, clean) <- inRepo $ Git.LsFiles.inRepo [top] liftIO . nukeFile =<< fromRepo gitAnnexViewIndex @@ -298,10 +270,10 @@ 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 + forM_ (genviewedfiles f metadata) $ \fv -> do stagesymlink uh hasher fv =<< inRepo (gitAnnexLink fv k) go uh hasher f Nothing | "." `isPrefixOf` f = do @@ -350,7 +322,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..b773e728d --- /dev/null +++ b/Annex/View/ViewedFile.hs @@ -0,0 +1,67 @@ +{- 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 where + +import Common.Annex +import Types.View +import Types.MetaData +import qualified Git +import qualified Git.DiffTree as DiffTree +import qualified Git.Branch +import qualified Git.LsFiles +import qualified Git.Ref +import Git.UpdateIndex +import Git.Sha +import Git.HashObject +import Git.Types +import Git.FilePath +import qualified Backend +import Annex.Index +import Annex.Link +import Annex.CatFile +import Logs.MetaData +import Logs.View +import Utility.Glob +import Utility.FileMode +import Types.Command +import Config +import CmdLine.Action + +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 file + - in some way. However, the branch's directory structure is not replicated + - 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}}.) + -} +viewedFileFromReference :: MkViewedFile +viewedFileFromReference 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 "}" "}}" + +viewedFileReuse :: MkViewedFile +viewedFileReuse = takeFileName 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/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 |