rename BlobType and add submodule to it
This was badly named, it's a not a blob necessarily, but anything that a tree can refer to. Also removed the Show instance which was used for serialization to git format, instead use fmtTreeItemType. This commit was supported by the NSF-funded DataLad project.
This commit is contained in:
parent
a732004616
commit
0b7f6d24d3
12 changed files with 80 additions and 69 deletions
|
@ -91,7 +91,7 @@ adjustTreeItem ShowMissingAdjustment = noAdjust
|
|||
|
||||
ifSymlink :: (TreeItem -> Annex a) -> (TreeItem -> Annex a) -> TreeItem -> Annex a
|
||||
ifSymlink issymlink notsymlink ti@(TreeItem _f m _s)
|
||||
| toBlobType m == Just SymlinkBlob = issymlink ti
|
||||
| toTreeItemType m == Just TreeSymlink = issymlink ti
|
||||
| otherwise = notsymlink ti
|
||||
|
||||
noAdjust :: TreeItem -> Annex (Maybe TreeItem)
|
||||
|
@ -101,7 +101,7 @@ adjustToPointer :: TreeItem -> Annex (Maybe TreeItem)
|
|||
adjustToPointer ti@(TreeItem f _m s) = catKey s >>= \case
|
||||
Just k -> do
|
||||
Database.Keys.addAssociatedFile k f
|
||||
Just . TreeItem f (fromBlobType FileBlob)
|
||||
Just . TreeItem f (fromTreeItemType TreeFile)
|
||||
<$> hashPointerFile k
|
||||
Nothing -> return (Just ti)
|
||||
|
||||
|
@ -114,7 +114,7 @@ adjustToSymlink' gitannexlink ti@(TreeItem f _m s) = catKey s >>= \case
|
|||
absf <- inRepo $ \r -> absPath $
|
||||
fromTopFilePath f r
|
||||
linktarget <- calcRepo $ gitannexlink absf k
|
||||
Just . TreeItem f (fromBlobType SymlinkBlob)
|
||||
Just . TreeItem f (fromTreeItemType TreeSymlink)
|
||||
<$> hashSymlink linktarget
|
||||
Nothing -> return (Just ti)
|
||||
|
||||
|
|
|
@ -23,7 +23,7 @@ import qualified Git.Merge
|
|||
import qualified Git.Ref
|
||||
import qualified Git
|
||||
import qualified Git.Branch
|
||||
import Git.Types (BlobType(..), fromBlobType)
|
||||
import Git.Types (TreeItemType(..), fromTreeItemType)
|
||||
import Git.FilePath
|
||||
import Config
|
||||
import Annex.ReplaceFile
|
||||
|
@ -185,21 +185,23 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do
|
|||
Just sha -> catKey sha
|
||||
Nothing -> return Nothing
|
||||
|
||||
islocked select = select (LsFiles.unmergedBlobType u) == Just SymlinkBlob
|
||||
islocked select = select (LsFiles.unmergedTreeItemType u) == Just TreeSymlink
|
||||
|
||||
combinedmodes = case catMaybes [ourmode, theirmode] of
|
||||
[] -> Nothing
|
||||
l -> Just (combineModes l)
|
||||
where
|
||||
ourmode = fromBlobType <$> LsFiles.valUs (LsFiles.unmergedBlobType u)
|
||||
theirmode = fromBlobType <$> LsFiles.valThem (LsFiles.unmergedBlobType u)
|
||||
ourmode = fromTreeItemType
|
||||
<$> LsFiles.valUs (LsFiles.unmergedTreeItemType u)
|
||||
theirmode = fromTreeItemType
|
||||
<$> LsFiles.valThem (LsFiles.unmergedTreeItemType u)
|
||||
|
||||
makeannexlink key select
|
||||
| islocked select = makesymlink key dest
|
||||
| otherwise = makepointer key dest destmode
|
||||
where
|
||||
dest = variantFile file key
|
||||
destmode = fromBlobType <$> select (LsFiles.unmergedBlobType u)
|
||||
destmode = fromTreeItemType <$> select (LsFiles.unmergedTreeItemType u)
|
||||
|
||||
stagefile :: FilePath -> Annex FilePath
|
||||
stagefile f
|
||||
|
@ -242,11 +244,11 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do
|
|||
=<< fromRepo (UpdateIndex.lsSubTree b item)
|
||||
|
||||
-- Update the work tree to reflect the graft.
|
||||
unless inoverlay $ case (selectwant (LsFiles.unmergedBlobType u), selectunwant (LsFiles.unmergedBlobType u)) of
|
||||
unless inoverlay $ case (selectwant (LsFiles.unmergedTreeItemType u), selectunwant (LsFiles.unmergedTreeItemType u)) of
|
||||
-- Symlinks are never left in work tree when
|
||||
-- there's a conflict with anything else.
|
||||
-- So, when grafting in a symlink, we must create it:
|
||||
(Just SymlinkBlob, _) -> do
|
||||
(Just TreeSymlink, _) -> do
|
||||
case selectwant' (LsFiles.unmergedSha u) of
|
||||
Nothing -> noop
|
||||
Just sha -> do
|
||||
|
@ -254,7 +256,7 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do
|
|||
replacewithsymlink item link
|
||||
-- And when grafting in anything else vs a symlink,
|
||||
-- the work tree already contains what we want.
|
||||
(_, Just SymlinkBlob) -> noop
|
||||
(_, Just TreeSymlink) -> noop
|
||||
_ -> ifM (withworktree item (liftIO . doesDirectoryExist))
|
||||
-- a conflict between a file and a directory
|
||||
-- leaves the directory, so since a directory
|
||||
|
|
|
@ -463,7 +463,7 @@ stageJournal jl = withIndex $ do
|
|||
sha <- Git.HashObject.hashFile h path
|
||||
hPutStrLn jlogh file
|
||||
streamer $ Git.UpdateIndex.updateIndexLine
|
||||
sha FileBlob (asTopFilePath $ fileJournal file)
|
||||
sha TreeFile (asTopFilePath $ fileJournal file)
|
||||
genstream dir h jh jlogh streamer
|
||||
-- Clean up the staged files, as listed in the temp log file.
|
||||
-- The temp file is used to avoid needing to buffer all the
|
||||
|
@ -573,7 +573,7 @@ performTransitionsLocked jl ts neednewlocalbranch transitionedrefs = do
|
|||
ChangeFile content' -> do
|
||||
sha <- hashBlob content'
|
||||
Annex.Queue.addUpdateIndex $ Git.UpdateIndex.pureStreamer $
|
||||
Git.UpdateIndex.updateIndexLine sha FileBlob (asTopFilePath file)
|
||||
Git.UpdateIndex.updateIndexLine sha TreeFile (asTopFilePath file)
|
||||
apply rest file content' trustmap
|
||||
PreserveFile ->
|
||||
apply rest file content trustmap
|
||||
|
|
|
@ -120,11 +120,11 @@ hashPointerFile key = hashBlob (formatPointer key)
|
|||
stagePointerFile :: FilePath -> Maybe FileMode -> Sha -> Annex ()
|
||||
stagePointerFile file mode sha =
|
||||
Annex.Queue.addUpdateIndex =<<
|
||||
inRepo (Git.UpdateIndex.stageFile sha blobtype file)
|
||||
inRepo (Git.UpdateIndex.stageFile sha treeitemtype file)
|
||||
where
|
||||
blobtype
|
||||
| maybe False isExecutable mode = ExecutableBlob
|
||||
| otherwise = FileBlob
|
||||
treeitemtype
|
||||
| maybe False isExecutable mode = TreeExecutable
|
||||
| otherwise = TreeFile
|
||||
|
||||
writePointerFile :: FilePath -> Key -> Maybe FileMode -> IO ()
|
||||
writePointerFile file k mode = do
|
||||
|
|
|
@ -71,9 +71,9 @@ scanUnlockedFiles = whenM (isJust <$> inRepo Git.Branch.current) $ do
|
|||
=<< catKey (Git.LsTree.sha i)
|
||||
liftIO $ void cleanup
|
||||
where
|
||||
isregfile i = case Git.Types.toBlobType (Git.LsTree.mode i) of
|
||||
Just Git.Types.FileBlob -> True
|
||||
Just Git.Types.ExecutableBlob -> True
|
||||
isregfile i = case Git.Types.toTreeItemType (Git.LsTree.mode i) of
|
||||
Just Git.Types.TreeFile -> True
|
||||
Just Git.Types.TreeExecutable -> True
|
||||
_ -> False
|
||||
add i k = do
|
||||
let tf = Git.LsTree.file i
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue