4 files changed, 218 insertions, 0 deletions
diff --git a/Command/VAdd.hs b/Command/VAdd.hs
new file mode 100644
index 000000000..e766f3939
--- /dev/null
+++ b/Command/VAdd.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.VAdd where
+
+import Common.Annex
+import Command
+import Annex.View
+import Logs.View
+import Command.View (paramView, parseViewParam, checkoutViewBranch)
+
+def :: [Command]
+def = [notBareRepo $ notDirect $
+	command "vadd" paramView seek SectionUtility "refine current view"]
+
+seek :: CommandSeek
+seek = withWords start
+
+start :: [String] -> CommandStart
+start params = do
+	showStart "vadd" ""
+	go =<< currentView
+  where
+	go Nothing = error "Not in a view."
+	go (Just view) = do
+		let (view', change) = calc view Unchanged (reverse params)
+		case change of
+			Unchanged -> do
+				showNote "unchanged"
+				next $ next $ return True
+			Narrowing -> next $ next $
+				checkoutViewBranch view' narrowView
+			Widening -> error "Widening view to match more files is not currently supported."
+
+	calc v c [] = (v, c)
+	calc v c (p:ps) =
+		let (v', c') = uncurry (refineView v) (parseViewParam p)
+		in calc v' (max c c') ps
diff --git a/Command/VCycle.hs b/Command/VCycle.hs
new file mode 100644
index 000000000..b41e099a4
--- /dev/null
+++ b/Command/VCycle.hs
@@ -0,0 +1,41 @@
+{- git-annex command
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.VCycle where
+
+import Common.Annex
+import Command
+import Annex.View
+import Types.View
+import Logs.View
+import Command.View (checkoutViewBranch)
+
+def :: [Command]
+def = [notBareRepo $ notDirect $
+	command "vcycle" paramNothing seek SectionUtility
+	"switch view to next layout"]
+
+seek :: CommandSeek
+seek = withNothing start
+
+start ::CommandStart
+start = go =<< currentView
+  where
+	go Nothing = error "Not in a view."
+	go (Just v) = do
+		showStart "vcycle" ""
+		let v' = v { viewComponents = vcycle [] (viewComponents v) }
+		if v == v'
+			then do
+				showNote "unchanged"
+				next $ next $ return True
+			else next $ next $ checkoutViewBranch v' narrowView
+
+	vcycle rest (c:cs)
+		| multiValue (viewFilter c) = rest ++ cs ++ [c]
+		| otherwise = vcycle (c:rest) cs
+	vcycle rest c = rest ++ c
diff --git a/Command/VPop.hs b/Command/VPop.hs
new file mode 100644
index 000000000..e62c2414a
--- /dev/null
+++ b/Command/VPop.hs
@@ -0,0 +1,43 @@
+{- 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
+		showStart "vpop" ""
+		removeView v
+		vs <- filter (sameparentbranch v) <$> recentViews
+		case vs of
+			(oldv:_) -> next $ next $ do
+				checkoutViewBranch oldv (return . branchView)
+			_ -> 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..9e1b981a7
--- /dev/null
+++ b/Command/View.hs
@@ -0,0 +1,92 @@
+{- 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 "searching"
+	next $ checkoutViewBranch view applyView
+
+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 -> (View -> Annex Git.Branch) -> CommandCleanup
+checkoutViewBranch view mkbranch = do
+	oldcwd <- liftIO getCurrentDirectory
+
+	{- Change to top of repository before creating view branch. -}
+	liftIO . setCurrentDirectory =<< fromRepo Git.repoPath
+	branch <- mkbranch view
+	
+	ok <- inRepo $ Git.Command.runBool
+		[ Param "checkout"
+		, Param (show $ Git.Ref.base branch)
+		]
+	when ok $ do
+		setView view
+		{- A git repo can easily have empty directories in it,
+		 - and this pollutes the view, so remove them. -}
+		liftIO $ removeemptydirs "."
+		unlessM (liftIO $ doesDirectoryExist oldcwd) $ do
+			top <- fromRepo Git.repoPath
+			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
+		]