1{- git-annex command
2 -
3 - Copyright 2014 Joey Hess <id@joeyh.name>
4 -
5 - Licensed under the GNU AGPL version 3 or higher.
6 -}
7
8module Command.View where
9
10import Command
11import qualified Git
12import qualified Git.Command
13import qualified Git.Ref
14import qualified Git.Branch
15import qualified Git.LsFiles as LsFiles
16import Git.FilePath
17import Git.Status
18import Types.View
19import Annex.View
20import Logs.View
21
22import qualified System.FilePath.ByteString as P
23
24cmd :: Command
25cmd = notBareRepo $
26	command "view" SectionMetaData "enter a view branch"
27		paramView (withParams seek)
28
29seek :: CmdParams -> CommandSeek
30seek = withWords (commandAction . start)
31
32start :: [String] -> CommandStart
33start [] = giveup "Specify metadata to include in view"
34start ps = ifM safeToEnterView
35	( do
36		view <- mkView ps
37		go view  =<< currentView
38	, giveup "Not safe to enter view."
39	)
40  where
41	ai = ActionItemOther Nothing
42	si = SeekInput ps
43	go view Nothing = starting "view" ai si $
44		perform view
45	go view (Just v)
46		| v == view = stop
47		| otherwise = giveup "Already in a view. Use the vfilter and vadd commands to further refine this view."
48
49safeToEnterView :: Annex Bool
50safeToEnterView = do
51	(l, cleanup) <- inRepo $ getStatus [] []
52	case filter dangerous l of
53		[] -> liftIO cleanup
54		_ -> do
55			warning "Your uncommitted changes would be lost when entering a view."
56			void $ liftIO cleanup
57			return False
58  where
59	dangerous (StagedUnstaged { staged = Nothing, unstaged = Nothing }) = False
60	-- Untracked files will not be affected by entering a view,
61	-- so are not dangerous.
62	dangerous (StagedUnstaged { staged = Just (Untracked _), unstaged = Nothing }) = False
63	dangerous (StagedUnstaged { unstaged = Just (Untracked _), staged = Nothing }) = False
64	dangerous (StagedUnstaged { unstaged = Just (Untracked _), staged = Just (Untracked _) }) = False
65	-- Staged changes would have their modifications either be
66	-- lost when entering a view, or committed as part of the view.
67	-- Either is dangerous because upon leaving the view; the staged
68	-- changes would be lost.
69	dangerous (StagedUnstaged { staged = Just _ }) = True
70	-- Unstaged changes to annexed files would get lost when entering a
71	-- view.
72	dangerous (StagedUnstaged { unstaged = Just _ }) = True
73
74perform :: View -> CommandPerform
75perform view = do
76	showAction "searching"
77	next $ checkoutViewBranch view applyView
78
79paramView :: String
80paramView = paramRepeating "FIELD=VALUE"
81
82mkView :: [String] -> Annex View
83mkView ps = go =<< inRepo Git.Branch.current
84  where
85	go Nothing = giveup "not on any branch!"
86	go (Just b) = return $ fst $ refineView (View b []) $
87		map parseViewParam $ reverse ps
88
89checkoutViewBranch :: View -> (View -> Annex Git.Branch) -> CommandCleanup
90checkoutViewBranch view mkbranch = do
91	here <- liftIO getCurrentDirectory
92
93	branch <- mkbranch view
94
95	showOutput
96	ok <- inRepo $ Git.Command.runBool
97		[ Param "checkout"
98		, Param (Git.fromRef $ Git.Ref.base branch)
99		]
100	when ok $ do
101		setView view
102		{- A git repo can easily have empty directories in it,
103		 - and this pollutes the view, so remove them.
104		 - (However, emptry directories used by submodules are not
105		 - removed.) -}
106		top <- liftIO . absPath =<< fromRepo Git.repoPath
107		(l, cleanup) <- inRepo $
108			LsFiles.notInRepoIncludingEmptyDirectories [] False [top]
109		forM_ l (removeemptydir top)
110		liftIO $ void cleanup
111		unlessM (liftIO $ doesDirectoryExist here) $ do
112			showLongNote (cwdmissing (fromRawFilePath top))
113	return ok
114  where
115	removeemptydir top d = do
116		p <- inRepo $ toTopFilePath d
117		liftIO $ tryIO $ removeDirectory $
118			fromRawFilePath $ (top P.</> getTopFilePath p)
119	cwdmissing top = unlines
120		[ "This view does not include the subdirectory you are currently in."
121		, "Perhaps you should:  cd " ++ top
122		]
123