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.

Annex/AdjustedBranch.hs

@@ -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)
 

Annex/AutoMerge.hs

@@ -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)
+		ourmode = fromTreeItemType
-		theirmode = fromBlobType <$> LsFiles.valThem (LsFiles.unmergedBlobType u)
+			<$> 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

Annex/Branch.hs

@@ -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

Annex/Link.hs

@@ -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
+	treeitemtype
-		| maybe False isExecutable mode = ExecutableBlob
+		| maybe False isExecutable mode = TreeExecutable
-		| otherwise = FileBlob
+		| otherwise = TreeFile
 
 writePointerFile :: FilePath -> Key -> Maybe FileMode -> IO ()
 writePointerFile file k mode = do

Annex/WorkTree.hs

@@ -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
+	isregfile i = case Git.Types.toTreeItemType (Git.LsTree.mode i) of
-		Just Git.Types.FileBlob -> True
+		Just Git.Types.TreeFile -> True
-		Just Git.Types.ExecutableBlob -> True
+		Just Git.Types.TreeExecutable -> True
 		_ -> False
 	add i k = do
 		let tf = Git.LsTree.file i

Command/DiffDriver.hs

@@ -85,8 +85,8 @@ fixupReq req@(Req {}) =
 	check rOldFile rOldMode (\r f -> r { rOldFile = f }) req
 		>>= check rNewFile rNewMode (\r f -> r { rNewFile = f })
   where
-	check getfile getmode setfile r = case readBlobType (getmode r) of
+	check getfile getmode setfile r = case readTreeItemType (getmode r) of
-		Just SymlinkBlob -> do
+		Just TreeSymlink -> do
 			v <- getAnnexLinkTarget' (getfile r) False
 			case fileKey . takeFileName =<< v of
 				Nothing -> return r

Git/LsFiles.hs

@@ -184,9 +184,9 @@ data Conflicting v = Conflicting
 
 data Unmerged = Unmerged
 	{ unmergedFile :: FilePath
-	, unmergedBlobType :: Conflicting BlobType
+	, unmergedTreeItemType :: Conflicting TreeItemType
 	, unmergedSha :: Conflicting Sha
-	} deriving (Show)
+	}
 
 {- Returns a list of the files in the specified locations that have
  - unresolved merge conflicts.
@@ -213,23 +213,23 @@ unmerged l repo = do
 data InternalUnmerged = InternalUnmerged
 	{ isus :: Bool
 	, ifile :: FilePath
-	, iblobtype :: Maybe BlobType
+	, itreeitemtype :: Maybe TreeItemType
 	, isha :: Maybe Sha
-	} deriving (Show)
+	}
 
 parseUnmerged :: String -> Maybe InternalUnmerged
 parseUnmerged s
 	| null file = Nothing
 	| otherwise = case words metadata of
-		(rawblobtype:rawsha:rawstage:_) -> do
+		(rawtreeitemtype:rawsha:rawstage:_) -> do
 			stage <- readish rawstage :: Maybe Int
 			if stage /= 2 && stage /= 3
 				then Nothing
 				else do
-					blobtype <- readBlobType rawblobtype
+					treeitemtype <- readTreeItemType rawtreeitemtype
 					sha <- extractSha rawsha
 					return $ InternalUnmerged (stage == 2) file
-						(Just blobtype) (Just sha)
+						(Just treeitemtype) (Just sha)
 		_ -> Nothing
   where
 	(metadata, file) = separate (== '\t') s
@@ -239,12 +239,12 @@ reduceUnmerged c [] = c
 reduceUnmerged c (i:is) = reduceUnmerged (new:c) rest
   where
 	(rest, sibi) = findsib i is
-	(blobtypeA, blobtypeB, shaA, shaB)
+	(treeitemtypeA, treeitemtypeB, shaA, shaB)
-		| isus i    = (iblobtype i, iblobtype sibi, isha i, isha sibi)
+		| isus i    = (itreeitemtype i, itreeitemtype sibi, isha i, isha sibi)
-		| otherwise = (iblobtype sibi, iblobtype i, isha sibi, isha i)
+		| otherwise = (itreeitemtype sibi, itreeitemtype i, isha sibi, isha i)
 	new = Unmerged
 		{ unmergedFile = ifile i
-		, unmergedBlobType = Conflicting blobtypeA blobtypeB
+		, unmergedTreeItemType = Conflicting treeitemtypeA treeitemtypeB
 		, unmergedSha = Conflicting shaA shaB
 		}
 	findsib templatei [] = ([], removed templatei)
@@ -253,6 +253,6 @@ reduceUnmerged c (i:is) = reduceUnmerged (new:c) rest
 		| otherwise = (l:ls, removed templatei)
 	removed templatei = templatei
 		{ isus = not (isus templatei)
-		, iblobtype = Nothing
+		, itreeitemtype = Nothing
 		, isha = Nothing
 		}

Git/Repair.hs

@@ -396,10 +396,10 @@ rewriteIndex r
 		void cleanup
 		return $ map fst3 bad
   where
-	reinject (file, Just sha, Just mode) = case toBlobType mode of
+	reinject (file, Just sha, Just mode) = case toTreeItemType mode of
 		Nothing -> return Nothing
-		Just blobtype -> Just <$>
+		Just treeitemtype -> Just <$>
-			UpdateIndex.stageFile sha blobtype file r
+			UpdateIndex.stageFile sha treeitemtype file r
 	reinject _ = return Nothing
 
 newtype GoodCommits = GoodCommits (S.Set Sha)

Git/Types.hs

@@ -1,6 +1,6 @@
 {- git data types
  -
- - Copyright 2010-2012 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2018 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -77,32 +77,36 @@ readObjectType "commit" = Just CommitObject
 readObjectType "tree" = Just TreeObject
 readObjectType _ = Nothing
 
-{- Types of blobs. -}
+{- Types of items in a tree. -}
-data BlobType = FileBlob | ExecutableBlob | SymlinkBlob
+data TreeItemType = TreeFile | TreeExecutable | TreeSymlink | TreeSubmodule
 	deriving (Eq)
 
-{- Git uses magic numbers to denote the type of a blob. -}
+{- Git uses magic numbers to denote the type of a tree item. -}
-instance Show BlobType where
+readTreeItemType :: String -> Maybe TreeItemType
-	show FileBlob = "100644"
+readTreeItemType "100644" = Just TreeFile
-	show ExecutableBlob = "100755"
+readTreeItemType "100755" = Just TreeExecutable
-	show SymlinkBlob = "120000"
+readTreeItemType "120000" = Just TreeSymlink
+readTreeItemType "160000" = Just TreeSubmodule
+readTreeItemType _ = Nothing
 
-readBlobType :: String -> Maybe BlobType
+fmtTreeItemType :: TreeItemType -> String
-readBlobType "100644" = Just FileBlob
+fmtTreeItemType TreeFile = "100644"
-readBlobType "100755" = Just ExecutableBlob
+fmtTreeItemType TreeExecutable = "100755"
-readBlobType "120000" = Just SymlinkBlob
+fmtTreeItemType TreeSymlink = "120000"
-readBlobType _ = Nothing
+fmtTreeItemType TreeSubmodule = "160000"
 
-toBlobType :: FileMode -> Maybe BlobType
+toTreeItemType :: FileMode -> Maybe TreeItemType
-toBlobType 0o100644 = Just FileBlob
+toTreeItemType 0o100644 = Just TreeFile
-toBlobType 0o100755 = Just ExecutableBlob
+toTreeItemType 0o100755 = Just TreeExecutable
-toBlobType 0o120000 = Just SymlinkBlob
+toTreeItemType 0o120000 = Just TreeSymlink
-toBlobType _ = Nothing
+toTreeItemType 0o160000 = Just TreeSubmodule
+toTreeItemType _ = Nothing
 
-fromBlobType :: BlobType -> FileMode
+fromTreeItemType :: TreeItemType -> FileMode
-fromBlobType FileBlob = 0o100644
+fromTreeItemType TreeFile = 0o100644
-fromBlobType ExecutableBlob = 0o100755
+fromTreeItemType TreeExecutable = 0o100755
-fromBlobType SymlinkBlob = 0o120000
+fromTreeItemType TreeSymlink = 0o120000
+fromTreeItemType TreeSubmodule = 0o160000
 
 data Commit = Commit
 	{ commitTree :: Sha

Git/UnionMerge.hs

@@ -91,7 +91,7 @@ mergeFile info file hashhandle h = case filter (/= nullSha) [Ref asha, Ref bsha]
   where
 	[_colonmode, _bmode, asha, bsha, _status] = words info
 	use sha = return $ Just $
-		updateIndexLine sha FileBlob $ asTopFilePath file
+		updateIndexLine sha TreeFile $ asTopFilePath file
 	-- We don't know how the file is encoded, but need to
 	-- split it into lines to union merge. Using the
 	-- FileSystemEncoding for this is a hack, but ensures there

Git/UpdateIndex.hs

@@ -83,14 +83,19 @@ lsSubTree (Ref x) p repo streamer = do
 
 {- Generates a line suitable to be fed into update-index, to add
  - a given file with a given sha. -}
-updateIndexLine :: Sha -> BlobType -> TopFilePath -> String
+updateIndexLine :: Sha -> TreeItemType -> TopFilePath -> String
-updateIndexLine sha filetype file =
+updateIndexLine sha treeitemtype file = concat
-	show filetype ++ " blob " ++ fromRef sha ++ "\t" ++ indexPath file
+	[ fmtTreeItemType treeitemtype
+	, " blob "
+	, fromRef sha
+	, "\t"
+	, indexPath file
+	]
 
-stageFile :: Sha -> BlobType -> FilePath -> Repo -> IO Streamer
+stageFile :: Sha -> TreeItemType -> FilePath -> Repo -> IO Streamer
-stageFile sha filetype file repo = do
+stageFile sha treeitemtype file repo = do
 	p <- toTopFilePath file repo
-	return $ pureStreamer $ updateIndexLine sha filetype p
+	return $ pureStreamer $ updateIndexLine sha treeitemtype p
 
 {- A streamer that removes a file from the index. -}
 unstageFile :: FilePath -> Repo -> IO Streamer
@@ -106,13 +111,13 @@ stageSymlink :: FilePath -> Sha -> Repo -> IO Streamer
 stageSymlink file sha repo = do
 	!line <- updateIndexLine
 		<$> pure sha
-		<*> pure SymlinkBlob
+		<*> pure TreeSymlink
 		<*> toTopFilePath file repo
 	return $ pureStreamer line
 
 {- A streamer that applies a DiffTreeItem to the index. -}
 stageDiffTreeItem :: Diff.DiffTreeItem -> Streamer
-stageDiffTreeItem d = case toBlobType (Diff.dstmode d) of
+stageDiffTreeItem d = case toTreeItemType (Diff.dstmode d) of
 	Nothing -> unstageFile' (Diff.file d)
 	Just t -> pureStreamer $ updateIndexLine (Diff.dstsha d) t (Diff.file d)
 

Test.hs

@@ -1402,7 +1402,7 @@ test_conflict_resolution_symlink_bit = unlessM (unlockedFiles <$> getTestMode) $
 	check_is_link f what = do
 		git_annex_expectoutput "find" ["--include=*", f] [Git.FilePath.toInternalGitPath f]
 		l <- annexeval $ Annex.inRepo $ Git.LsTree.lsTreeFiles Git.Ref.headRef [f]
-		all (\i -> Git.Types.toBlobType (Git.LsTree.mode i) == Just Git.Types.SymlinkBlob) l
+		all (\i -> Git.Types.toTreeItemType (Git.LsTree.mode i) == Just Git.Types.TreeSymlink) l
 			@? (what ++ " " ++ f ++ " lost symlink bit after merge: " ++ show l)
 
 {- A v6 unlocked file that conflicts with a locked file should be resolved