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.

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)
-		| isus i    = (iblobtype i, iblobtype sibi, isha i, isha sibi)
-		| otherwise = (iblobtype sibi, iblobtype i, isha sibi, isha i)
+	(treeitemtypeA, treeitemtypeB, shaA, shaB)
+		| isus i    = (itreeitemtype i, itreeitemtype sibi, isha i, isha sibi)
+		| 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 <$>
-			UpdateIndex.stageFile sha blobtype file r
+		Just treeitemtype -> Just <$>
+			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. -}
-data BlobType = FileBlob | ExecutableBlob | SymlinkBlob
+{- Types of items in a tree. -}
+data TreeItemType = TreeFile | TreeExecutable | TreeSymlink | TreeSubmodule
 	deriving (Eq)
 
-{- Git uses magic numbers to denote the type of a blob. -}
-instance Show BlobType where
-	show FileBlob = "100644"
-	show ExecutableBlob = "100755"
-	show SymlinkBlob = "120000"
+{- Git uses magic numbers to denote the type of a tree item. -}
+readTreeItemType :: String -> Maybe TreeItemType
+readTreeItemType "100644" = Just TreeFile
+readTreeItemType "100755" = Just TreeExecutable
+readTreeItemType "120000" = Just TreeSymlink
+readTreeItemType "160000" = Just TreeSubmodule
+readTreeItemType _ = Nothing
 
-readBlobType :: String -> Maybe BlobType
-readBlobType "100644" = Just FileBlob
-readBlobType "100755" = Just ExecutableBlob
-readBlobType "120000" = Just SymlinkBlob
-readBlobType _ = Nothing
+fmtTreeItemType :: TreeItemType -> String
+fmtTreeItemType TreeFile = "100644"
+fmtTreeItemType TreeExecutable = "100755"
+fmtTreeItemType TreeSymlink = "120000"
+fmtTreeItemType TreeSubmodule = "160000"
 
-toBlobType :: FileMode -> Maybe BlobType
-toBlobType 0o100644 = Just FileBlob
-toBlobType 0o100755 = Just ExecutableBlob
-toBlobType 0o120000 = Just SymlinkBlob
-toBlobType _ = Nothing
+toTreeItemType :: FileMode -> Maybe TreeItemType
+toTreeItemType 0o100644 = Just TreeFile
+toTreeItemType 0o100755 = Just TreeExecutable
+toTreeItemType 0o120000 = Just TreeSymlink
+toTreeItemType 0o160000 = Just TreeSubmodule
+toTreeItemType _ = Nothing
 
-fromBlobType :: BlobType -> FileMode
-fromBlobType FileBlob = 0o100644
-fromBlobType ExecutableBlob = 0o100755
-fromBlobType SymlinkBlob = 0o120000
+fromTreeItemType :: TreeItemType -> FileMode
+fromTreeItemType TreeFile = 0o100644
+fromTreeItemType TreeExecutable = 0o100755
+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 filetype file =
-	show filetype ++ " blob " ++ fromRef sha ++ "\t" ++ indexPath file
+updateIndexLine :: Sha -> TreeItemType -> TopFilePath -> String
+updateIndexLine sha treeitemtype file = concat
+	[ fmtTreeItemType treeitemtype
+	, " blob "
+	, fromRef sha
+	, "\t"
+	, indexPath file
+	]
 
-stageFile :: Sha -> BlobType -> FilePath -> Repo -> IO Streamer
-stageFile sha filetype file repo = do
+stageFile :: Sha -> TreeItemType -> FilePath -> Repo -> IO Streamer
+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)