1 files changed, 88 insertions, 0 deletions
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
+		]