add git annex view command

(And a vpop command, which is still a bit buggy.)

Still need to do vadd and vrm, though this also adds their documentation.

Currently not very happy with the view log data serialization. I had to
lose the TDFA regexps temporarily, so I can have Read/Show instances of
View. I expect the view log format will change in some incompatable way
later, probably adding last known refs for the parent branch to View
or something like that.

Anyway, it basically works, although it's a bit slow looking up the
metadata. The actual git branch construction is about as fast as it can be
using the current git plumbing.

This commit was sponsored by Peter Hogg.

18 files changed, 485 insertions, 183 deletions

diff --git a/Annex/Branch.hs b/Annex/Branch.hs
index ee3cd71e2..fe505a048 100644
--- a/Annex/Branch.hs
+++ b/Annex/Branch.hs
@@ -5,8 +5,6 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE CPP #-}
-
 module Annex.Branch (
 	fullname,
 	name,
@@ -30,11 +28,11 @@ module Annex.Branch (
 import qualified Data.ByteString.Lazy.Char8 as L
 import qualified Data.Set as S
 import qualified Data.Map as M
-import qualified Control.Exception as E
 
 import Common.Annex
 import Annex.BranchState
 import Annex.Journal
+import Annex.Index
 import qualified Git
 import qualified Git.Command
 import qualified Git.Ref
@@ -47,15 +45,12 @@ import Git.Types
 import Git.FilePath
 import Annex.CatFile
 import Annex.Perms
-import qualified Annex
-import Utility.Env
 import Logs
 import Logs.Transitions
 import Logs.Trust.Pure
 import Annex.ReplaceFile
 import qualified Annex.Queue
 import Annex.Branch.Transitions
-import Annex.Exception
 
 {- Name of the branch that is used to store git-annex's information. -}
 name :: Git.Ref
@@ -338,32 +333,12 @@ withIndex = withIndex' False
 withIndex' :: Bool -> Annex a -> Annex a
 withIndex' bootstrapping a = do
 	f <- fromRepo gitAnnexIndex
-	g <- gitRepo
-#ifdef __ANDROID__
-	{- This should not be necessary on Android, but there is some
-	 - weird getEnvironment breakage. See
-	 - https://github.com/neurocyte/ghc-android/issues/7
-	 - Use getEnv to get some key environment variables that
-	 - git expects to have. -}
-	let keyenv = words "USER PATH GIT_EXEC_PATH HOSTNAME HOME"
-	let getEnvPair k = maybe Nothing (\v -> Just (k, v)) <$> getEnv k
-	e <- liftIO $ catMaybes <$> forM keyenv getEnvPair
-	let e' = ("GIT_INDEX_FILE", f):e
-#else
-	e <- liftIO getEnvironment
-	let e' = addEntry "GIT_INDEX_FILE" f e
-#endif
-	let g' = g { gitEnv = Just e' }
-
-	r <- tryAnnex $ do
-		Annex.changeState $ \s -> s { Annex.repo = g' }
+	withIndexFile f $ do
 		checkIndexOnce $ unlessM (liftIO $ doesFileExist f) $ do
 			unless bootstrapping create
 			createAnnexDirectory $ takeDirectory f
 			unless bootstrapping $ inRepo genIndex
 		a
-	Annex.changeState $ \s -> s { Annex.repo = (Annex.repo s) { gitEnv = gitEnv g} }
-	either E.throw return r
 
 {- Updates the branch's index to reflect the current contents of the branch.
  - Any changes staged in the index will be preserved.
diff --git a/Annex/Index.hs b/Annex/Index.hs
new file mode 100644
index 000000000..a1b2442fc
--- /dev/null
+++ b/Annex/Index.hs
@@ -0,0 +1,46 @@
+{- Using other git index files
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Annex.Index (
+	withIndexFile,
+) where
+
+import qualified Control.Exception as E
+
+import Common.Annex
+import Git.Types
+import qualified Annex
+import Utility.Env
+import Annex.Exception
+
+{- Runs an action using a different git index file. -}
+withIndexFile :: FilePath -> Annex a -> Annex a
+withIndexFile f a = do
+	g <- gitRepo
+#ifdef __ANDROID__
+	{- This should not be necessary on Android, but there is some
+	 - weird getEnvironment breakage. See
+	 - https://github.com/neurocyte/ghc-android/issues/7
+	 - Use getEnv to get some key environment variables that
+	 - git expects to have. -}
+	let keyenv = words "USER PATH GIT_EXEC_PATH HOSTNAME HOME"
+	let getEnvPair k = maybe Nothing (\v -> Just (k, v)) <$> getEnv k
+	e <- liftIO $ catMaybes <$> forM keyenv getEnvPair
+	let e' = ("GIT_INDEX_FILE", f):e
+#else
+	e <- liftIO getEnvironment
+	let e' = addEntry "GIT_INDEX_FILE" f e
+#endif
+	let g' = g { gitEnv = Just e' }
+
+	r <- tryAnnex $ do
+		Annex.changeState $ \s -> s { Annex.repo = g' }
+		a
+	Annex.changeState $ \s -> s { Annex.repo = (Annex.repo s) { gitEnv = gitEnv g} }
+	either E.throw return r
diff --git a/Annex/Link.hs b/Annex/Link.hs
index 234e4cb2a..26991e911 100644
--- a/Annex/Link.hs
+++ b/Annex/Link.hs
@@ -94,6 +94,10 @@ hashSymlink :: LinkTarget -> Annex Sha
 hashSymlink linktarget = inRepo $ Git.HashObject.hashObject BlobObject $ 
 	toInternalGitPath linktarget
 
+hashSymlink' :: Git.HashObject.HashObjectHandle -> LinkTarget -> Annex Sha
+hashSymlink' h linktarget = liftIO $ Git.HashObject.hashBlob h $
+	toInternalGitPath linktarget
+
 {- Stages a symlink to the annex, using a Sha of its target. -}
 stageSymlink :: FilePath -> Sha -> Annex ()
 stageSymlink file sha =
diff --git a/Annex/View.hs b/Annex/View.hs
index 890f2682a..0af46680b 100644
--- a/Annex/View.hs
+++ b/Annex/View.hs
@@ -5,61 +5,46 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE CPP #-}
-
 module Annex.View where
 
 import Common.Annex
 import Types.View
 import Types.MetaData
-import qualified Git.Types as Git
-import qualified Git.Ref
+import qualified Git
 import qualified Git.DiffTree
 import qualified Git.Branch
-import Git.Sha (nullSha)
+import qualified Git.LsFiles
+import Git.UpdateIndex
+import Git.Sha
+import Git.HashObject
+import qualified Backend
+import Annex.Index
+import Annex.Link
+import Logs.MetaData
+import Logs.View
 
 import qualified Data.Set as S
-import Data.Char
 import System.Path.WildMatch
 import "mtl" Control.Monad.Writer
 
-#ifdef WITH_TDFA
-import Text.Regex.TDFA
-import Text.Regex.TDFA.String
-#else
-#endif
-
-matchGlob :: Glob -> String -> Bool
-#ifdef WITH_TDFA
-matchGlob (Glob _ r) s = case execute r s of
-	Right (Just _) -> True
-	_ -> False
-#else
-matchGlob (Glob g) = wildCheckCase g
-#endif
-
 data ViewChange = Unchanged | Narrowing | Widening
 	deriving (Ord, Eq, Show)
 
+matchGlob :: String -> String -> Bool
+matchGlob glob val = wildCheckCase glob val
+
 {- Updates a view, adding a new field to filter on (Narrowing), 
- - or allowing a new value in an existing field (Widening).
- -}
+ - or allowing a new value in an existing field (Widening). -}
 refineView :: View -> MetaField -> String -> (View, ViewChange)
 refineView view field wanted
-	| field `elem` (map viewField view) = 
-		let (view', viewchanges) = runWriter $ mapM updatefield view
-		in (view', maximum viewchanges)
-	| otherwise = (ViewComponent field viewfilter : view, Narrowing)
+	| field `elem` (map viewField components) = 
+		let (components', viewchanges) = runWriter $ mapM updatefield components
+		in (view { viewComponents = components' }, maximum viewchanges)
+	| otherwise = (view { viewComponents = ViewComponent field viewfilter : components }, Narrowing)
   where
+  	components = viewComponents view
 	viewfilter
-		| any (`elem` wanted) "*?" = 
-#ifdef WITH_TDFA
-			case compile defaultCompOpt defaultExecOpt ('^':wildToRegex wanted) of
-				Right r -> FilterGlob (Glob wanted r)
-				Left _ -> FilterValues $ S.singleton $ toMetaValue wanted
-#else
-			FilterGlob (Glob wanted)
-#endif
+		| any (`elem` wanted) "*?" = FilterGlob wanted
 		| otherwise = FilterValues $ S.singleton $ toMetaValue wanted
 	updatefield :: ViewComponent -> Writer [ViewChange] ViewComponent
 	updatefield v
@@ -96,14 +81,9 @@ combineViewFilter (FilterGlob oldglob) new@(FilterValues s)
 	| otherwise = (new, Widening)
 combineViewFilter (FilterGlob old) newglob@(FilterGlob new)
 	| old == new = (newglob, Unchanged)
-	| matchGlob old (getGlob new) = (newglob, Narrowing)
+	| matchGlob old new = (newglob, Narrowing)
 	| otherwise = (newglob, Widening)
 
-{- Can a ViewFilter match multiple different MetaValues? -}
-multiValue :: ViewFilter -> Bool
-multiValue (FilterValues s) = S.size s > 1
-multiValue (FilterGlob _) = True
-
 {- Each multivalued ViewFilter in a view results in another level of
  - subdirectory nesting. When a file matches multiple ways, it will appear
  - in multiple subdirectories. This means there is a bit of an exponential
@@ -113,7 +93,7 @@ multiValue (FilterGlob _) = True
  - through 5+ levels of subdirectories to find anything?
  -}
 viewTooLarge :: View -> Bool
-viewTooLarge view = length (filter (multiValue . viewFilter) view) > 5
+viewTooLarge view = length (filter (multiValue . viewFilter) (viewComponents view)) > 5
 
 {- Checks if metadata matches a filter, and if so returns the value,
  - or values that match. -}
@@ -166,15 +146,19 @@ fileViewFromReference f = concat
 fileViews :: View -> MkFileView -> FilePath -> MetaData -> [FileView]
 fileViews view mkfileview file metadata
 	| any isNothing matches = []
-	| otherwise = map (</> mkfileview file) $ pathProduct $ 
-		map (map toViewPath) (visible matches)
+	| otherwise =
+		let paths = pathProduct $
+			map (map toViewPath) (visible matches)
+		in if null paths
+			then [mkfileview file]
+			else map (</> mkfileview file) paths
   where
   	matches :: [Maybe [MetaValue]]
-	matches = map (matchFilter metadata) view
+	matches = map (matchFilter metadata) (viewComponents view)
 	visible :: [Maybe [MetaValue]] -> [[MetaValue]]
 	visible = map (fromJust . snd) .
 		filter (multiValue . fst) .
-		zip (map viewFilter view)
+		zip (map viewFilter (viewComponents view))
 
 toViewPath :: MetaValue -> FilePath
 toViewPath = concatMap escapeslash . fromMetaValue
@@ -218,7 +202,7 @@ pathProduct (l:ls) = foldl combinel l ls
 fromView :: View -> FileView -> MetaData
 fromView view f = foldr (uncurry updateMetaData) newMetaData (zip fields values)
   where
-	visible = filter (multiValue . viewFilter) view
+	visible = filter (multiValue . viewFilter) (viewComponents view)
 	fields = map viewField visible
 	paths = splitDirectories $ dropFileName f
 	values = map fromViewPath paths
@@ -231,47 +215,19 @@ prop_view_roundtrips :: FilePath -> MetaData -> Bool
 prop_view_roundtrips f metadata = null f || viewTooLarge view ||
 	all hasfields (fileViews view fileViewFromReference f metadata)
   where
-	view = map (\(mf, mv) -> ViewComponent mf (FilterValues $ S.filter (not . null . fromMetaValue) mv))
-		(fromMetaData metadata)
-	visiblefields = sort (map viewField $ filter (multiValue . viewFilter) view)
+	view = View (Git.Ref "master") $
+		map (\(mf, mv) -> ViewComponent mf (FilterValues $ S.filter (not . null . fromMetaValue) mv))
+			(fromMetaData metadata)
+	visiblefields = sort (map viewField $ filter (multiValue . viewFilter) (viewComponents view))
 	hasfields fv = sort (map fst (fromMetaData (fromView view fv))) == visiblefields
 
-{- Generates a git branch name for a View.
- - 
- - There is no guarantee that each view gets a unique branch name,
- - but the branch name is used to express the view as well as possible.
- -}
-branchView :: View -> Git.Branch
-branchView view
-	| null name = Git.Ref "refs/views"
-	| otherwise = Git.Ref $ "refs/views/" ++ name
-  where
-	name = intercalate "/" $ map branchcomp view
-	branchcomp c
-		| multiValue (viewFilter c) = branchcomp' c
-		| otherwise = "(" ++ branchcomp' c ++ ")"
-	branchcomp' (ViewComponent metafield viewfilter)
-		| metafield == tagMetaField = branchvals viewfilter
-		| otherwise = concat
-			[ forcelegal (fromMetaField metafield)
-			, "="
-			, branchvals viewfilter
-			]
-	branchvals (FilterValues set) = forcelegal $
-		intercalate "," $ map fromMetaValue $ S.toList set
-	branchvals (FilterGlob glob) = forcelegal $ getGlob glob
-	forcelegal s
-		| Git.Ref.legal True s = s
-		| otherwise = map (\c -> if isAlphaNum c then c else '_') s
-
-prop_branchView_legal :: View -> Bool
-prop_branchView_legal = Git.Ref.legal False . show . branchView
-
 {- Applies a view to the currently checked out branch, generating a new
  - branch for the view.
  -}
 applyView :: View -> Annex Git.Branch
-applyView = applyView' fileViewFromReference
+applyView view = do
+	liftIO . nukeFile =<< fromRepo gitAnnexViewIndex
+	applyView' fileViewFromReference view
 
 {- Generates a new branch for a View, which must be a more narrow
  - version of the View originally used to generate the currently
@@ -283,11 +239,32 @@ narrowView = applyView' id
 {- 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,
- - and stage them into the (temporary) index.
+ - and stage them.
+ -
+ - Currently only works in indirect mode.
  -}
 applyView' :: MkFileView -> View -> Annex Git.Branch
-applyView' mkfileview view = genViewBranch view $ do
-	error "TODO"
+applyView' mkfileview view = do
+	top <- fromRepo Git.repoPath
+	(l, clean) <- inRepo $ Git.LsFiles.inRepo [top]
+	genViewBranch view $ do
+		uh <- inRepo Git.UpdateIndex.startUpdateIndex
+		hasher <- inRepo hashObjectStart
+		forM_ l $ \f ->
+			go uh hasher f =<< Backend.lookupFile f
+		liftIO $ do
+			hashObjectStop hasher
+			void $ stopUpdateIndex uh
+			void clean
+  where
+	go uh hasher f Nothing = noop -- TODO dotfiles
+	go uh hasher f (Just (k, _)) = do
+		metadata <- getCurrentMetaData k
+		forM_ (fileViews view mkfileview f metadata) $ \fv -> do
+			linktarget <- inRepo $ gitAnnexLink fv k
+			sha <- hashSymlink' hasher linktarget
+			liftIO . Git.UpdateIndex.streamUpdateIndex' uh
+				=<< inRepo (Git.UpdateIndex.stageSymlink fv sha)
 
 {- Applies a view to the reference branch, generating a new branch
  - for the View.
@@ -307,18 +284,21 @@ updateView view ref oldref = genViewBranch view $ do
 		| Git.DiffTree.dstsha diff == nullSha = error "TODO delete file"
 		| otherwise = error "TODO add file"
 
-{- Generates a branch for a view. This is done by creating a temporary
- - index file, which starts off empty. An action is run to stage the files
- - that will be in the branch. Then a commit is made, to the view branch.
- - The view branch is not checked out, but entering it will display the
- - view. -}
+{- Generates a branch for a view. This is done using a different index
+ - file. An action is run to stage the files that will be in the branch.
+ - Then a commit is made, to the view branch. The view branch is not
+ - checked out, but entering it will display the view. -}
 genViewBranch :: View -> Annex () -> Annex Git.Branch
-genViewBranch view a = withTempIndex $ do
+genViewBranch view a = withIndex $ do
 	a
 	let branch = branchView view
 	void $ inRepo $ Git.Branch.commit True (show branch) branch []
 	return branch
 
-{- -}
-withTempIndex :: Annex a -> Annex a
-withTempIndex a = error "TODO"
+{- Runs an action using the view index file.
+ - Note that the file does not necessarily exist, or can contain
+ - info staged for an old view. -}
+withIndex :: Annex a -> Annex a
+withIndex a = do
+	f <- fromRepo gitAnnexViewIndex
+	withIndexFile f a
diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs
index a67c6be29..49d34e17f 100644
--- a/CmdLine/GitAnnex.hs
+++ b/CmdLine/GitAnnex.hs
@@ -27,6 +27,8 @@ import qualified Command.TransferKey
 import qualified Command.TransferKeys
 import qualified Command.ReKey
 import qualified Command.MetaData
+import qualified Command.View
+import qualified Command.VPop
 import qualified Command.Reinject
 import qualified Command.Fix
 import qualified Command.Init
@@ -136,6 +138,8 @@ cmds = concat
 	, Command.TransferKeys.def
 	, Command.ReKey.def
 	, Command.MetaData.def
+	, Command.View.def
+	, Command.VPop.def
 	, Command.Fix.def
 	, Command.Fsck.def
 	, Command.Repair.def
diff --git a/Command/VPop.hs b/Command/VPop.hs
new file mode 100644
index 000000000..03905b751
--- /dev/null
+++ b/Command/VPop.hs
@@ -0,0 +1,42 @@
+{- git-annex command
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.VPop where
+
+import Common.Annex
+import Command
+import qualified Git.Command
+import qualified Git.Ref
+import Types.View
+import Logs.View
+import Command.View (checkoutViewBranch)
+
+def :: [Command]
+def = [notBareRepo $ notDirect $
+	command "vpop" paramNothing seek SectionUtility
+	"switch back to previous view"]
+
+seek :: CommandSeek
+seek = withNothing start
+
+start ::CommandStart
+start = go =<< currentView
+  where
+	go Nothing = error "Not in a view."
+	go (Just v) = do
+		vs <- dropWhile (/= v) . filter (sameparentbranch v)
+			<$> recentViews
+		case vs of
+			(_v:oldv:_) -> next $ next $ 
+				checkoutViewBranch oldv (branchView oldv)
+			_ -> next $ next $
+				inRepo $ Git.Command.runBool
+					[ Param "checkout"
+					, Param $ show $ Git.Ref.base $
+						viewParentBranch v
+					]
+	sameparentbranch a b = viewParentBranch a == viewParentBranch b
diff --git a/Command/View.hs b/Command/View.hs
new file mode 100644
index 000000000..309a1ccbe
--- /dev/null
+++ b/Command/View.hs
@@ -0,0 +1,88 @@
+{- git-annex command
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.View where
+
+import Common.Annex
+import Command
+import qualified Git
+import qualified Git.Command
+import qualified Git.Ref
+import qualified Git.Branch
+import Types.MetaData
+import Types.View
+import Annex.View
+import Logs.View
+
+def :: [Command]
+def = [notBareRepo $ notDirect $
+	command "view" paramView seek SectionUtility "enter a view branch"]
+
+seek :: CommandSeek
+seek = withWords start
+
+start :: [String] -> CommandStart
+start [] = error "Specify metadata to include in view"
+start params = do
+	showStart "view" ""
+	view <- mkView params
+	go view  =<< currentView
+  where
+	go view Nothing = next $ perform view
+	go view (Just v)
+		| v == view = stop
+		| otherwise = error "Already in a view. Use 'git annex vadd' to further refine this view."
+
+perform :: View -> CommandPerform
+perform view = do
+	showSideAction "calculating"
+	branch <- applyView view
+	next $ checkoutViewBranch view branch
+
+paramView :: String
+paramView = paramPair (paramRepeating "FIELD=VALUE") (paramRepeating "TAG")
+
+parseViewParam :: String -> (MetaField, String)
+parseViewParam s = case separate (== '=') s of
+	(tag, []) -> (tagMetaField, tag)
+	(field, wanted) -> either error (\f -> (f, wanted)) (mkMetaField field)
+
+mkView :: [String] -> Annex View
+mkView params = do
+	v <- View <$> viewbranch <*> pure []
+	return $ calc v $ reverse params
+  where
+	calc v [] = v
+	calc v (p:ps) =
+		let (v', _) = uncurry (refineView v) (parseViewParam p)
+		in calc v' ps
+	viewbranch = fromMaybe (error "not on any branch!")
+		<$> inRepo Git.Branch.current
+
+checkoutViewBranch :: View -> Git.Branch -> CommandCleanup
+checkoutViewBranch view branch = do
+	ok <- inRepo $ Git.Command.runBool
+		[ Param "checkout"
+		, Param (show $ Git.Ref.base branch)
+		]
+	when ok $ do
+		setView view
+		top <- fromRepo Git.repoPath
+		cwd <- liftIO getCurrentDirectory
+		{- A git repo can easily have empty directories in it,
+		 - and this pollutes the view, so remove them. -}
+		liftIO $ removeemptydirs top
+		unlessM (liftIO $ doesDirectoryExist cwd) $
+			showLongNote (cwdmissing top)
+	return ok
+  where
+	removeemptydirs top = mapM_ (tryIO . removeDirectory)
+		=<< dirTreeRecursiveSkipping (".git" `isSuffixOf`) top
+	cwdmissing top = unlines
+		[ "This view does not include the subdirectory you are currently in."
+		, "Perhaps you should:  cd " ++ top
+		]
diff --git a/Git/HashObject.hs b/Git/HashObject.hs
index bb9b20d96..97e1befe6 100644
--- a/Git/HashObject.hs
+++ b/Git/HashObject.hs
@@ -1,6 +1,6 @@
 {- git hash-object interface
  -
- - Copyright 2011-2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2011-2014 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -13,6 +13,7 @@ import Git.Sha
 import Git.Command
 import Git.Types
 import qualified Utility.CoProcess as CoProcess
+import Utility.Tmp
 
 type HashObjectHandle = CoProcess.CoProcessHandle
 
@@ -34,7 +35,18 @@ hashFile h file = CoProcess.query h send receive
 	send to = hPutStrLn to file
 	receive from = getSha "hash-object" $ hGetLine from
 
-{- Injects some content into git, returning its Sha. -}
+{- Injects a blob into git. Unfortunately, the current git-hash-object
+ - interface does not allow batch hashing without using temp files. -}
+hashBlob :: HashObjectHandle -> String -> IO Sha
+hashBlob h s = withTmpFile "hash" $ \tmp tmph -> do
+	hPutStr tmph s
+	hClose tmph
+	hashFile h tmp
+
+{- Injects some content into git, returning its Sha.
+ - 
+ - Avoids using a tmp file, but runs a new hash-object command each
+ - time called. -}
 hashObject :: ObjectType -> String -> Repo -> IO Sha
 hashObject objtype content = hashObject' objtype (flip hPutStr content)
 
diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs
index 3b33ac846..73beaba3a 100644
--- a/Git/UpdateIndex.hs
+++ b/Git/UpdateIndex.hs
@@ -11,6 +11,9 @@ module Git.UpdateIndex (
 	Streamer,
 	pureStreamer,
 	streamUpdateIndex,
+	streamUpdateIndex',
+	startUpdateIndex,
+	stopUpdateIndex,
 	lsTree,
 	updateIndexLine,
 	stageFile,
@@ -25,6 +28,9 @@ import Git.Command
 import Git.FilePath
 import Git.Sha
 
+import Control.Exception (bracket)
+import System.Process (std_in)
+
 {- Streamers are passed a callback and should feed it lines in the form
  - read by update-index, and generated by ls-tree. -}
 type Streamer = (String -> IO ()) -> IO ()
@@ -35,16 +41,29 @@ pureStreamer !s = \streamer -> streamer s
 
 {- Streams content into update-index from a list of Streamers. -}
 streamUpdateIndex :: Repo -> [Streamer] -> IO ()
-streamUpdateIndex repo as = pipeWrite params repo $ \h -> do
+streamUpdateIndex repo as = bracket (startUpdateIndex repo) stopUpdateIndex $
+	(\h -> forM_ as $ streamUpdateIndex' h)
+
+data UpdateIndexHandle = UpdateIndexHandle ProcessHandle Handle
+
+streamUpdateIndex' :: UpdateIndexHandle -> Streamer -> IO ()
+streamUpdateIndex' (UpdateIndexHandle _ h) a = a $ \s -> do
+	hPutStr h s
+	hPutStr h "\0"
+
+startUpdateIndex :: Repo -> IO UpdateIndexHandle
+startUpdateIndex repo = do
+	(Just h, _, _, p) <- createProcess (gitCreateProcess params repo)
+		{ std_in = CreatePipe }
 	fileEncoding h
-	forM_ as (stream h)
-	hClose h
+	return $ UpdateIndexHandle p h
   where
 	params = map Param ["update-index", "-z", "--index-info"]
-	stream h a = a (streamer h)
-	streamer h s = do
-		hPutStr h s
-		hPutStr h "\0"
+
+stopUpdateIndex :: UpdateIndexHandle -> IO Bool
+stopUpdateIndex (UpdateIndexHandle p h) = do
+	hClose h
+	checkSuccessProcess p
 
 {- A streamer that adds the current tree for a ref. Useful for eg, copying
  - and modifying branches. -}
diff --git a/Locations.hs b/Locations.hs
index f1580bf24..8189b8a07 100644
--- a/Locations.hs
+++ b/Locations.hs
@@ -40,6 +40,8 @@ module Locations (
 	gitAnnexJournalLock,
 	gitAnnexIndex,
 	gitAnnexIndexStatus,
+	gitAnnexViewIndex,
+	gitAnnexViewLog,
 	gitAnnexIgnoredRefs,
 	gitAnnexPidFile,
 	gitAnnexDaemonStatusFile,
@@ -252,6 +254,14 @@ gitAnnexIndex r = gitAnnexDir r </> "index"
 gitAnnexIndexStatus :: Git.Repo -> FilePath
 gitAnnexIndexStatus r = gitAnnexDir r </> "index.lck"
 
+{- The index file used to generate a filtered branch view._-}
+gitAnnexViewIndex :: Git.Repo -> FilePath
+gitAnnexViewIndex r = gitAnnexDir r </> "viewindex"
+
+{- File containing a log of recently accessed views. -}
+gitAnnexViewLog :: Git.Repo -> FilePath
+gitAnnexViewLog r = gitAnnexDir r </> "viewlog"
+
 {- List of refs that should not be merged into the git-annex branch. -}
 gitAnnexIgnoredRefs :: Git.Repo -> FilePath
 gitAnnexIgnoredRefs r = gitAnnexDir r </> "ignoredrefs"
diff --git a/Logs/View.hs b/Logs/View.hs
new file mode 100644
index 000000000..9739992ae
--- /dev/null
+++ b/Logs/View.hs
@@ -0,0 +1,92 @@
+{- git-annex recent views log
+ -
+ - The most recently accessed view comes first.
+ -
+ - This file is stored locally in .git/annex/, not in the git-annex branch.
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Logs.View (
+	currentView,
+	setView,
+	recentViews,
+	branchView,
+	prop_branchView_legal,
+) where
+
+import Common.Annex
+import Types.View
+import Types.MetaData
+import qualified Git
+import qualified Git.Branch
+import qualified Git.Ref
+import Utility.Tmp
+
+import qualified Data.Set as S
+import Data.Char
+
+showLog :: View -> String
+showLog (View branch components) = show branch ++ " " ++ show components
+
+parseLog :: String -> Maybe View
+parseLog s = 
+	let (branch, components) = separate (== ' ') s
+	in View
+		<$> pure (Git.Ref branch)
+		<*> readish components
+
+setView :: View -> Annex ()
+setView v = do
+	l <- take 99 . filter (/= v) <$> recentViews
+	f <- fromRepo gitAnnexViewLog
+	liftIO $ viaTmp writeFile f $ unlines $ map showLog (v : l)
+
+recentViews :: Annex [View]
+recentViews = do
+	f <- fromRepo gitAnnexViewLog
+	liftIO $ mapMaybe parseLog . lines <$> catchDefaultIO [] (readFile f)
+
+{- Gets the currently checked out view, if there is one. -}
+currentView :: Annex (Maybe View)
+currentView = do
+	vs <- recentViews
+	maybe Nothing (go vs) <$> inRepo Git.Branch.current
+  where
+  	go [] _ = Nothing
+	go (v:vs) b
+		| branchView v == b = Just v
+		| otherwise = go vs b
+
+{- Generates a git branch name for a View.
+ - 
+ - There is no guarantee that each view gets a unique branch name,
+ - but the branch name is used to express the view as well as possible.
+ -}
+branchView :: View -> Git.Branch
+branchView view
+	| null name = Git.Ref "refs/heads/views"
+	| otherwise = Git.Ref $ "refs/heads/views/" ++ name
+  where
+	name = intercalate ";" $ map branchcomp (viewComponents view)
+	branchcomp c
+		| multiValue (viewFilter c) = branchcomp' c
+		| otherwise = "(" ++ branchcomp' c ++ ")"
+	branchcomp' (ViewComponent metafield viewfilter)
+		| metafield == tagMetaField = branchvals viewfilter
+		| otherwise = concat
+			[ forcelegal (fromMetaField metafield)
+			, "="
+			, branchvals viewfilter
+			]
+	branchvals (FilterValues set) = forcelegal $
+		intercalate "," $ map fromMetaValue $ S.toList set
+	branchvals (FilterGlob glob) = forcelegal glob
+	forcelegal s
+		| Git.Ref.legal True s = s
+		| otherwise = map (\c -> if isAlphaNum c then c else '_') s
+
+prop_branchView_legal :: View -> Bool
+prop_branchView_legal = Git.Ref.legal False . show . branchView
diff --git a/Test.hs b/Test.hs
index 64ec11074..624636ed5 100644
--- a/Test.hs
+++ b/Test.hs
@@ -55,6 +55,7 @@ import qualified Crypto
 import qualified Annex.Init
 import qualified Annex.CatFile
 import qualified Annex.View
+import qualified Logs.View
 import qualified Utility.Path
 import qualified Utility.FileMode
 import qualified Build.SysConfig
@@ -148,7 +149,7 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck"
 	, testProperty "prop_duration_roundtrips" Utility.HumanTime.prop_duration_roundtrips
 	, testProperty "prop_metadata_sane" Types.MetaData.prop_metadata_sane
 	, testProperty "prop_metadata_serialize" Types.MetaData.prop_metadata_serialize
-	, testProperty "prop_branchView_legal" Annex.View.prop_branchView_legal
+	, testProperty "prop_branchView_legal" Logs.View.prop_branchView_legal
 	, testProperty "prop_view_roundtrips" Annex.View.prop_view_roundtrips
 	]
 
diff --git a/Types/MetaData.hs b/Types/MetaData.hs
index 248a96abb..601757315 100644
--- a/Types/MetaData.hs
+++ b/Types/MetaData.hs
@@ -53,13 +53,13 @@ newtype MetaData = MetaData (M.Map MetaField (S.Set MetaValue))
 {- A metadata value can be currently be set (True), or may have been
  - set before and we're remembering it no longer is (False). -}
 newtype CurrentlySet = CurrentlySet Bool
-	deriving (Show, Eq, Ord, Arbitrary)
+	deriving (Read, Show, Eq, Ord, Arbitrary)
 
 newtype MetaField = MetaField String
-	deriving (Show, Eq, Ord)
+	deriving (Read, Show, Eq, Ord)
 
 data MetaValue = MetaValue CurrentlySet String
-	deriving (Show)
+	deriving (Read, Show)
 
 {- Metadata values compare and order the same whether currently set or not. -}
 instance Eq MetaValue where
diff --git a/Types/View.hs b/Types/View.hs
index 2c30541fa..f1759e0e0 100644
--- a/Types/View.hs
+++ b/Types/View.hs
@@ -5,29 +5,31 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE CPP #-}
-
 module Types.View where
 
 import Common.Annex
 import Types.MetaData
 import Utility.QuickCheck
+import qualified Git
 
 import qualified Data.Set as S
 
-#ifdef WITH_TDFA
-import Text.Regex.TDFA
-#else
-#endif
+{- A view is a list of fields with filters on their allowed values,
+ - which are applied to files in a parent git branch. -}
+data View = View
+	{ viewParentBranch :: Git.Branch
+	, viewComponents :: [ViewComponent]
+	}
+	deriving (Eq, Show)
 
-{- A view is a list of fields with filters on their allowed values. -}
-type View = [ViewComponent]
+instance Arbitrary View where
+	arbitrary = View <$> pure (Git.Ref "master") <*> arbitrary
 
 data ViewComponent = ViewComponent
 	{ viewField :: MetaField
 	, viewFilter :: ViewFilter
 	}
-	deriving (Show, Eq)
+	deriving (Eq, Show, Read)
 
 instance Arbitrary ViewComponent where
 	arbitrary = ViewComponent <$> arbitrary <*> arbitrary
@@ -38,34 +40,15 @@ type MkFileView = FilePath -> FileView
 
 data ViewFilter
 	= FilterValues (S.Set MetaValue)
-	| FilterGlob Glob
-
-instance Show ViewFilter where
-	show (FilterValues s) = show s
-	show (FilterGlob g) = getGlob g
-
-instance Eq ViewFilter where
-	FilterValues x == FilterValues y = x == y
-	FilterGlob x == FilterGlob y = x == y
-	_ == _ = False
+	| FilterGlob String
+	deriving (Eq, Show, Read)
 
 instance Arbitrary ViewFilter where
 	arbitrary = do
 		size <- arbitrarySizedBoundedIntegral `suchThat` (< 100)
 		FilterValues . S.fromList <$> vector size
 
-#ifdef WITH_TDFA
-data Glob = Glob String Regex
-#else
-data Glob = Glob String
-#endif
-
-instance Eq Glob where
-	a == b = getGlob a == getGlob b
-
-getGlob :: Glob -> String
-#ifdef WITH_TDFA
-getGlob (Glob g _) = g
-#else
-getGlob (Glob g) = g
-#endif
+{- Can a ViewFilter match multiple different MetaValues? -}
+multiValue :: ViewFilter -> Bool
+multiValue (FilterValues s) = S.size s > 1
+multiValue (FilterGlob _) = True
diff --git a/Utility/Directory.hs b/Utility/Directory.hs
index c457de6e3..f1bcfada3 100644
--- a/Utility/Directory.hs
+++ b/Utility/Directory.hs
@@ -1,6 +1,6 @@
 {- directory manipulation
  -
- - Copyright 2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2011-2014 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -23,6 +23,7 @@ import Utility.SafeCommand
 import Utility.Tmp
 import Utility.Exception
 import Utility.Monad
+import Utility.Applicative
 
 dirCruft :: FilePath -> Bool
 dirCruft "." = True
@@ -73,6 +74,21 @@ dirContentsRecursiveSkipping skipdir followsubdirsymlinks topdir = go [topdir]
 							)
 				_ -> skip
 
+{- Gets the directory tree from a point, recursively and lazily,
+ - with leaf directories **first**, skipping any whose basenames
+ - match the skipdir. Does not follow symlinks. -}
+dirTreeRecursiveSkipping :: (FilePath -> Bool) -> FilePath -> IO [FilePath]
+dirTreeRecursiveSkipping skipdir topdir = go [] [topdir]
+  where
+  	go c [] = return c
+	go c (dir:dirs)
+		| skipdir (takeFileName dir) = go c dirs
+		| otherwise = unsafeInterleaveIO $ do
+			subdirs <- go c
+				=<< filterM (isDirectory <$$> getSymbolicLinkStatus)
+				=<< catchDefaultIO [] (dirContents dir)
+			go (subdirs++[dir]) dirs
+
 {- Moves one filename to another.
  - First tries a rename, but falls back to moving across devices if needed. -}
 moveFile :: FilePath -> FilePath -> IO ()
diff --git a/debian/changelog b/debian/changelog
index ab0807091..dd28c5c9b 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -5,6 +5,9 @@ git-annex (5.20140211) UNRELEASED; urgency=medium
     that have particular metadata.
   * Preferred content expressions can use metadata=field=value
     to limit them to acting on files that have particular metadata.
+  * view: New command that creates and checks out a branch that provides
+    a structured view of selected metadata.
+  * vadd, vrm, vpop: New commands for operating within views.
   * Add progress display for transfers to/from external special remotes.
   * Windows webapp: Can set up box.com, Amazon S3, and rsync.net remotes
   * Windows webapp: Can create repos on removable drives.
diff --git a/doc/design/metadata.mdwn b/doc/design/metadata.mdwn
index 4edfa6d72..0e8727415 100644
--- a/doc/design/metadata.mdwn
+++ b/doc/design/metadata.mdwn
@@ -36,37 +36,37 @@ sql queries if we want to go that far.)
 
 # filtered branches
 
-`git annex filter year=2014 talk` should create a new branch
-filtered/year=2014/talk containing only files tagged with that, and
+`git annex view year=2014 talk` should create a new branch
+view/year=2014/talk containing only files tagged with that, and
 have git check it out. In this example, all files appear in top level
 directory of repo; no subdirs.
 
-`git annex fadd haskell` switches to branch
-filtered/year=2014/talk/haskell with only the haskell talks.
+`git annex vadd haskell` switches to branch
+view/year=2014/talk/haskell with only the haskell talks.
 
-`git annex fadd year=2013 year=2012` switches to branch
-filtered/year=2012,2013,2014/talk/haskell. This has subdirectories 2012,
+`git annex vadd year=2013 year=2012` switches to branch
+view/year=2012,2013,2014/talk/haskell. This has subdirectories 2012,
 2013 and 2014 with the matching talks.
 
 Patterns can be used in both the values of fields, and in matching tags.
 So, `year=20*` could be used to match years, and `foo/*` matches any
 tag in the foo namespace. Or even `*` to match *all* tags.
 
-`git annex frm haskell` switches to
-filtered/year=2012,2013,2014/talk, which has all available talks in it.
+`git annex vrm haskell` switches to
+view/year=2012,2013,2014/talk, which has all available talks in it.
 
-`git annex fadd conference=fosdem conference=icfp` switches to branch
-filtered/year=2012,2013,2014/talk/conference=fosdem,icfp. Now there
+`git annex vadd conference=fosdem conference=icfp` switches to branch
+view/year=2012,2013,2014/talk/conference=fosdem,icfp. Now there
 are nested subdirectories. They follow the format of the branch,
 so 2013/icfp, 2014/fosdem, etc.
 
-`git annex filter tag=haskell,debian` yields a branch with haskell
+`git annex view tag=haskell,debian` yields a branch with haskell
 and debian subdirectories.
 
-To see all tags, `git annex filter tag=*` !
+To see all tags, as subdirectories, `git annex view tag=*` !
 
-Files not matching the filter can be included, by using 
-`git annex filter --unmatched=other`. That puts all such files into
+Files not matching the view can be included, by using 
+`git annex view --unmatched=other`. That puts all such files into
 the subdirectory other.
 
 Note that old filter branches can be deleted when switching to a new one.
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 1b7271092..84cb55a43 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -313,6 +313,33 @@ subdirectories).
   from a remote computer.
   Note that this does not yet use HTTPS for security, so use with caution!
 
+* `view [field=value ...] [tag ...]`
+
+  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.
+  
+  Multiple values for a metadata field can be specified, either by using
+  a glob (field="\*") or by listing each wanted value. 
+  
+  When multiple field values match, the view branch will have a
+  subdirectory for each value.
+
+* `vadd [field=value ...] [tag ...]`
+
+  Can be used when already in a view to add additional fields or tags
+  to the view.
+
+* `vrm [field=value ...] [tag ...]`
+
+  Can be used when already in a view to remove fields or tags from the
+  view.
+
+* `vpop`
+
+  Switches from the currently active view back to the previous view.
+
 # REPOSITORY SETUP COMMANDS
 
 * `init [description]`