adjust: Fix behavior when used in a repository that contains submodules.

Also fixed the LsFiles parser to not assume its output has a fixed width
type field.

CHANGELOG

@@ -24,6 +24,8 @@ git-annex (6.20170215) UNRELEASED; urgency=medium
     git-annex branch merging, etc, when being used to get information.
   * git-annex.cabal: Make crypto-api a dependency even when built w/o
     webapp and test suite.
+  * adjust: Fix behavior when used in a repository that contains
+    submodules.
 
  -- Joey Hess <id@joeyh.name>  Tue, 14 Feb 2017 15:54:25 -0400
 

Git/LsTree.hs

@@ -24,6 +24,7 @@ import Git.FilePath
 import qualified Git.Filename
 
 import Numeric
+import Data.Char
 import System.Posix.Types
 
 data TreeItem = TreeItem
@@ -66,7 +67,9 @@ lsTreeFiles t fs repo = map parseLsTree <$> pipeNullSplitStrict ps repo
 		, File $ fromRef t
 		] ++ map File fs
 
-{- Parses a line of ls-tree output.
+{- Parses a line of ls-tree output, in format:
+ - mode SP type SP sha TAB file
+ -
  - (The --long format is not currently supported.) -}
 parseLsTree :: String -> TreeItem
 parseLsTree l = TreeItem 
@@ -76,12 +79,9 @@ parseLsTree l = TreeItem
 	, file = sfile
 	}
   where
-	-- l = <mode> SP <type> SP <sha> TAB <file>
+	(m, past_m) = splitAt 7 l -- mode is 6 bytes
-	-- All fields are fixed, so we can pull them out of
+	(!t, past_t) = separate isSpace past_m
-	-- specific positions in the line.
+	(!s, past_s) = splitAt shaSize past_t
-	(m, past_m) = splitAt 7 l
+	!f = drop 1 past_s
-	(!t, past_t) = splitAt 4 past_m
-	(!s, past_s) = splitAt shaSize $ Prelude.tail past_t
-	!f = Prelude.tail past_s
 	!smode = fst $ Prelude.head $ readOct m
 	!sfile = asTopFilePath $ Git.Filename.decode f

Git/Tree.hs

@@ -35,11 +35,14 @@ newtype Tree = Tree [TreeContent]
 	deriving (Show)
 
 data TreeContent
+	-- A blob object in the tree.
 	= TreeBlob TopFilePath FileMode Sha
 	-- A subtree that is already recorded in git, with a known sha.
 	| RecordedSubTree TopFilePath Sha [TreeContent]
 	-- A subtree that has not yet been recorded in git.
 	| NewSubTree TopFilePath [TreeContent]
+	-- A commit object that is part of a tree (used for submodules)
+	| TreeCommit TopFilePath FileMode Sha
 	deriving (Show, Eq, Ord)
 
 {- Gets the Tree for a Ref. -}
@@ -93,6 +96,7 @@ mkTree (MkTreeHandle cp) l = CoProcess.query cp send receive
 			TreeBlob f fm s -> mkTreeOutput fm BlobObject s f
 			RecordedSubTree f s _ -> mkTreeOutput 0o040000 TreeObject s f
 			NewSubTree _ _ -> error "recordSubTree internal error; unexpected NewSubTree"
+			TreeCommit f fm s -> mkTreeOutput fm CommitObject s f
 		hPutStr h "\NUL" -- signal end of tree to --batch
 	receive h = getSha "mktree" (hGetLine h)
 
@@ -152,6 +156,7 @@ flattenTree n (Tree l) = Tree (concatMap (go n) l)
 	go _ b@(TreeBlob _ _ _) = [b]
 	go n' (RecordedSubTree _ _ l') = concatMap (go (n'-1)) l'
 	go n' (NewSubTree _ l') = concatMap (go (n'-1)) l'
+	go _ c@(TreeCommit _ _ _) = [c]
 
 {- Applies an adjustment to items in a tree.
  -
@@ -200,6 +205,9 @@ adjustTree adjusttreeitem addtreeitems removefiles r repo =
 					else return $ RecordedSubTree (LsTree.file i) (LsTree.sha i) [] 
 				let !modified' = modified || slmodified || wasmodified
 				go h modified' (subtree : c) depth intree is'
+			Just CommitObject -> do
+				let ti = TreeCommit (LsTree.file i) (LsTree.mode i)  (LsTree.sha i)
+				go h wasmodified (ti:c) depth intree is
 			_ -> error ("unexpected object type \"" ++ LsTree.typeobj i ++ "\"")
 		| otherwise = return (c, wasmodified, i:is)
 
@@ -236,6 +244,9 @@ extractTree l = case go [] inTopTree l of
 					let st = RecordedSubTree (LsTree.file i) (LsTree.sha i) subtree
 					in go (st:t) intree is'
 				Left e -> Left e
+			Just CommitObject ->
+				let c = TreeCommit (LsTree.file i) (LsTree.mode i) (LsTree.sha i)
+				in go (c:t) intree is
 			_ -> parseerr ("unexpected object type \"" ++ LsTree.typeobj i ++ "\"")
 		| otherwise = Right (t, i:is)
 	parseerr = Left
@@ -259,6 +270,7 @@ instance GitPath TreeContent where
 	gitPath (TreeBlob f _ _) = gitPath f
 	gitPath (RecordedSubTree f _ _) = gitPath f
 	gitPath (NewSubTree f _) = gitPath f
+	gitPath (TreeCommit f _ _) = gitPath f
 
 inTopTree :: GitPath t => t -> Bool
 inTopTree = inTree "."

doc/bugs/Can__39__t_use_adjusted_branch_in_v6__44___if_submodule_already_is_using_this_feature.mdwn

@@ -54,3 +54,4 @@ operating system: linux x86_64
 ### Have you had any luck using git-annex before? (Sometimes we get tired of reading bug reports all day and a lil' positive end note does wonders)
 
 
+> [[fixed|done]] --[[Joey]]

doc/bugs/Can__39__t_use_adjusted_branch_in_v6__44___if_submodule_already_is_using_this_feature/comment_1_176faba802ecd62b04c06c6dab77f5f3._comment

@@ -0,0 +1,20 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2017-02-20T17:13:54Z"
+ content="""
+Error message is:
+
+	git-annex: unexpected object type "comm"
+
+What it's actually choking on is the "commit" object for the submodule,
+in git-ls-tree output. Doesn't matter if the submodule uses
+adjusted branches or not.
+
+The parser for ls-tree output is buggy;
+it's expecting only "blob" and "tree", so pulls out a fixed width 4
+characters: "comm"
+
+Also, the adjusted branch code needs to be made to skip over CommitObjects,
+once the parser is fixed to generate them.
+"""]]