factor out new module

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]
+viewedFiles :: View -> MkViewedFile -> FilePath -> MetaData -> [ViewedFile]
-fileViews view = 
+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]
+					then [mkviewedfile file]
-					else map (</> mkfileview file) paths
+					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' :: MkViewedFile -> View -> Annex Git.Branch
-applyView' mkfileview view = do
+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

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

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

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