summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Annex/View.hs64
-rw-r--r--Annex/View/ViewedFile.hs67
-rw-r--r--Command/PreCommit.hs5
-rw-r--r--Types/View.hs4
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