summaryrefslogtreecommitdiff
path: root/Command/View.hs
blob: 4e642e50f2ace4d436122274e9fb3b668c5a6508 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
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 "searching"
	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
		]