d7021d420f
This fixes a crash when a git submodule has a name starting with a dot. Such a submodule might contain dotfiles that are intended to be used when inside the view (since a dot-directory that's not a submodule was already preserved when entering a view). So, rather than eliminating the submodule from the view, its git ls-files --stage hash is copied over into the view. dotfiles/dirs have their git ls-files --stage hashes similarly copied over to the view. This is more efficient and simpler than the old method, and also won't break if git ever adds a new type of tree item, like was done with submodules. Since the content of dotfiles in the working tree is no longer hashed when entering a view, when there are unstaged modifications, they are not included in the view branch. Entering the view branch still works, but git checkout shows "M .dotfile", and git diff will show the unstaged changes. This seems like an improvement over the old behavior. Also made Command.View not delete empty directories that are submodules when entering a view, while still deleting other empty directories. This commit was supported by the NSF-funded DataLad project.
88 lines
2.4 KiB
Haskell
88 lines
2.4 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2014 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.View where
|
|
|
|
import Command
|
|
import qualified Git
|
|
import qualified Git.Command
|
|
import qualified Git.Ref
|
|
import qualified Git.Branch
|
|
import qualified Git.LsFiles as LsFiles
|
|
import Git.FilePath
|
|
import Types.View
|
|
import Annex.View
|
|
import Logs.View
|
|
|
|
cmd :: Command
|
|
cmd = notBareRepo $ notDirect $
|
|
command "view" SectionMetaData "enter a view branch"
|
|
paramView (withParams seek)
|
|
|
|
seek :: CmdParams -> CommandSeek
|
|
seek = withWords start
|
|
|
|
start :: [String] -> CommandStart
|
|
start [] = giveup "Specify metadata to include in view"
|
|
start ps = do
|
|
showStart' "view" Nothing
|
|
view <- mkView ps
|
|
go view =<< currentView
|
|
where
|
|
go view Nothing = next $ perform view
|
|
go view (Just v)
|
|
| v == view = stop
|
|
| otherwise = giveup "Already in a view. Use the vfilter and vadd commands to further refine this view."
|
|
|
|
perform :: View -> CommandPerform
|
|
perform view = do
|
|
showAction "searching"
|
|
next $ checkoutViewBranch view applyView
|
|
|
|
paramView :: String
|
|
paramView = paramRepeating "FIELD=VALUE"
|
|
|
|
mkView :: [String] -> Annex View
|
|
mkView ps = go =<< inRepo Git.Branch.current
|
|
where
|
|
go Nothing = giveup "not on any branch!"
|
|
go (Just b) = return $ fst $ refineView (View b []) $
|
|
map parseViewParam $ reverse ps
|
|
|
|
checkoutViewBranch :: View -> (View -> Annex Git.Branch) -> CommandCleanup
|
|
checkoutViewBranch view mkbranch = do
|
|
here <- liftIO getCurrentDirectory
|
|
|
|
branch <- mkbranch view
|
|
|
|
showOutput
|
|
ok <- inRepo $ Git.Command.runBool
|
|
[ Param "checkout"
|
|
, Param (Git.fromRef $ 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.
|
|
- (However, emptry directories used by submodules are not
|
|
- removed.) -}
|
|
top <- liftIO . absPath =<< fromRepo Git.repoPath
|
|
(l, cleanup) <- inRepo $
|
|
LsFiles.notInRepoIncludingEmptyDirectories False [top]
|
|
forM_ l (removeemptydir top)
|
|
liftIO $ void cleanup
|
|
unlessM (liftIO $ doesDirectoryExist here) $ do
|
|
showLongNote (cwdmissing top)
|
|
return ok
|
|
where
|
|
removeemptydir top d = do
|
|
p <- inRepo $ toTopFilePath d
|
|
liftIO $ tryIO $ removeDirectory (top </> getTopFilePath p)
|
|
cwdmissing top = unlines
|
|
[ "This view does not include the subdirectory you are currently in."
|
|
, "Perhaps you should: cd " ++ top
|
|
]
|