diff --git a/Annex/View.hs b/Annex/View.hs index eb3254e8ed..d407ce4c97 100644 --- a/Annex/View.hs +++ b/Annex/View.hs @@ -244,7 +244,8 @@ narrowView = applyView' fileViewReuse - Look up the metadata of annexed files, and generate any FileViews, - and stage them. - - - Currently only works in indirect mode. + - Currently only works in indirect mode. Must be run from top of + - repository. -} applyView' :: MkFileView -> View -> Annex Git.Branch applyView' mkfileview view = do diff --git a/Command/VAdd.hs b/Command/VAdd.hs index a79e912152..e766f39393 100644 --- a/Command/VAdd.hs +++ b/Command/VAdd.hs @@ -9,7 +9,6 @@ module Command.VAdd where import Common.Annex import Command -import Types.View import Annex.View import Logs.View import Command.View (paramView, parseViewParam, checkoutViewBranch) @@ -33,15 +32,11 @@ start params = do 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." - Narrowing -> next $ perform view' 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 - -perform :: View -> CommandPerform -perform view = do - branch <- narrowView view - next $ checkoutViewBranch view branch diff --git a/Command/VCycle.hs b/Command/VCycle.hs index c32ce2eb15..c1bee30b6e 100644 --- a/Command/VCycle.hs +++ b/Command/VCycle.hs @@ -32,14 +32,9 @@ start = go =<< currentView then do showNote "unchanged" next $ next $ return True - else next $ perform v' + 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 - -perform :: View -> CommandPerform -perform view = do - branch <- narrowView view - next $ checkoutViewBranch view branch diff --git a/Command/VPop.hs b/Command/VPop.hs index 03905b751a..52c2b7f0cd 100644 --- a/Command/VPop.hs +++ b/Command/VPop.hs @@ -32,7 +32,7 @@ start = go =<< currentView <$> recentViews case vs of (_v:oldv:_) -> next $ next $ - checkoutViewBranch oldv (branchView oldv) + checkoutViewBranch oldv (return . branchView) _ -> next $ next $ inRepo $ Git.Command.runBool [ Param "checkout" diff --git a/Command/View.hs b/Command/View.hs index 4e642e50f2..9e1b981a7e 100644 --- a/Command/View.hs +++ b/Command/View.hs @@ -40,8 +40,7 @@ start params = do perform :: View -> CommandPerform perform view = do showSideAction "searching" - branch <- applyView view - next $ checkoutViewBranch view branch + next $ checkoutViewBranch view applyView paramView :: String paramView = paramPair (paramRepeating "FIELD=VALUE") (paramRepeating "TAG") @@ -63,20 +62,25 @@ mkView params = do viewbranch = fromMaybe (error "not on any branch!") <$> inRepo Git.Branch.current -checkoutViewBranch :: View -> Git.Branch -> CommandCleanup -checkoutViewBranch view branch = do +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 - 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) $ + liftIO $ removeemptydirs "." + unlessM (liftIO $ doesDirectoryExist oldcwd) $ do + top <- fromRepo Git.repoPath showLongNote (cwdmissing top) return ok where