summaryrefslogtreecommitdiff
path: root/Annex/View.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-02-22 13:35:50 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-02-22 13:35:50 -0400
commit8e609f7a026795a106a819916e7d6756544b528e (patch)
tree04f3de0c13ba86df8da47559369ff7565a210679 /Annex/View.hs
parent067aaa4b4ef6a56e67caad1933812083ac09ce16 (diff)
factor out new module
Diffstat (limited to 'Annex/View.hs')
-rw-r--r--Annex/View.hs64
1 files changed, 18 insertions, 46 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